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Executive Overview Software Crisis 


—~> +: Motivation, History, Strategy 


+ Software late, over cost, unreliable, difficult to maintain 


Be cena * — Skyrocketing software expenditures 


«- Software for Embedded Computer Systems - 1974 


; * Projections of manpower falling behind 
«= Components of the Implementation of the Strategy 


+» Why a New Language? + Symptoms were most severe in embedded systems 
«- Three Legs of the Language 


+» Adacontinues the tradition 


+ Themes & Examples 


«Effective use of Ada 
«= Software Engineering Principles and Ada 
* Object-Oriented Design and Ada 


«. Alternative Solutions to Problems and 
their Impact on Software Goals 


+ Emerging Software Scene 


*» Technology 


«« Human Resources 


«« Business Practices 


« Applications 
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Software for Embedded Components of the 
Computer Systems - 1974 Implementation of the Strategy 
* More than half of DoD Software Expenditures 
* The Facts 


LIFE-CYCLE 
METHODS 


++ Unique hardware with unique assembly language 
for each weapon system 


MODERN 
HIGH-ORDER, 
LANGUGE 


Several hundred such languages 


Everything special purpose and thus single use * Life-Cycle Methods 


(software, training, experience) «Recognize software as a large, complex, long-lived 


creation to be manipulated and used by many 


No cost spreading through multiple use 
«« Coordinate large numbers of people over 
4 « The Results long periods of time 


«+ Improve maintainability, readability etc. 


: +» High life cycle cost in time and money for both 


development and modification + Automated Tools 
| ++ Low quality (Reliability, Efficiency, Modifiability) oa oe ene aD 
+ The Strategy «« Make methods cost effective through automation 
e« Lifecycle Engineering approach * Single, Modern, High-order Language 
«« Multiple use of software, training, experience ++ — Single: multizle use of tools, people, software, etc. 
+» Automation of much of the process ** Modern: Permits expression and enforcement of 


encapsulation, reuse, concurrency, real-time, etc. 


(©1988 RICHARO EE BOLZ 
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Why a New Language? 


* No existing language adequately addressed the 
requirements 


* — Result is a highly pratense tool whose mastery 
requires considerable training and experience 


+ Anatural extension of the evolutionary chain of 
programming languages 
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Ada continues the tradition of providing 
facilities to describe objects at ever higher 
levels of abstraction 


Problem Space -- Very High Level Application Specific 
Problem Oriented Languages 


1980 Ada Packages, Generics, Tasking, 
trong Typing, Extensibility) 
1973 ALPHARD, EL1, CLU 
exami Abstraction and 
asking Facilities) 
1969 Pascal (Data Structures) 
1960 Algol (Formal Definition, Block Structure, 
Control Structures, Parameter 
Mechanisms) 
1954 Fortran (Algebraic Expressions, Parameterized 
Procedures) 
1951 IBM 650 Assembly Language 
(Locations, Mnemonics) 
194X Machine Language 


(All work done by programmer) 


Machine Space -- Low Level Hardware Specific Machine 
Languages 
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Three Legs of the language 


« — Standard Definition 
+ Ansi/Mil Std 1815a (1983) 
+» ISO Std (1987) 
* — Validation 
«» Approximately 3000 test programs 
* Assures compliance with standard 


e« Annual revalidation required 


* Many Validated Implementations 


83 84 85 86 87 88 
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MACHINE LANGUAGE 


NO ABSTRACTION 


01100011 
11001110 
00001100 


ASSEMBLY LANGUAGE 
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FORTRAN (1954) ALGOL (1960) 


If-then-else, while, repeat, etc 
X=(Y¥+2Z)*V 


INSTEAD OF 
INSTEAD OF tab es 
LDA Y =e 
ADD Z L3: GO TO 12 
MLT V & ts 
STA X GO TO L1 
12: — 
R SPA SOLUTION SPACE PROBLEM SPACE SOLUTION SPACE 
ALGOL 
WORLD 
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Pascal (1970) Ada (1980) 


Arrays, records, sets, ENCAPSULATION/LOCALIZATION 
arrays of records of arrays, PROCEDURAL ABSTRACTION 
enumerated values (SUN, MON, ..., SAT) INFORMATION HIDING 
ABSTRACT DATA TYPES 
INSTEAD OF 
INSTEAD OF 


Low-level data structures, 
Great rellance on the integers Rellance on standards ("Thou shalt not... .") 
to enforce good software engineering practices 


PROBLEM SPACE = = SOLUTION SPACE = = PROBLEM SPACE = j= — SOLUTION SPACE 


ae I} ans 
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Executive Overview 


* Motivation, History, Strategy 
«Software Crisis 
+» Software for Embedded Computer Systems - 1974 
+: Components of the Implementation of the Strategy 
«. Why a New Language? 
«+ Three Legs of the Language 


+ Ada continues the tradition 


Themes & Examples 


« Effective use of Ada 
«» Software Engineering Principles and Ada 
+» Object-Oriented Design and Ada 


«Alternative Solutions to Problems and 
their Impact on Software Goals 


» Emerging Software Scene 
*» Technology 
«« Human Resources 
«Business Practices 


«Applications 
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Effective Use of Ada 


Effective Use of Ada yields many benefits 

*« Problem space fidelity and direct expressibility 
*« Explicit expression of design decisions 

e+ Enforced information hiding 

«+ Isolation of machine and system dependencies 
** Precise control over values and value checking 
ee Clean and understandable error handling 


*e Increased automatic control (and reduced 
manual control) of the software 


Features Key to the Effective Use of Ada 
ee User-defined Data Types 

ee Packaging 

*e Separate Compilation 

ee Exception Handling 

*« Generics 


*- ~=Tasking 


Software Engineering with Ada i Sa tee, 
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Effective use of Ada's greater expressive power 
«= to express solutions in problem space terms 
+= to express information about the software itself 


*» to express more precien information about the 
computation itself 


«+ Information is expressed in compilable Ada Code 
processable by the compiler and other tools 

Several ways to approach the use of Ada's 

expressive power 

** Software Engineering Principles and Ada 

** Object-Oriented Design and Ada 


* Alternative Solutions to Problems and their 
Impact on Software Goals 
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User-defined Data types 


+ Adais a strongly-typed language 

° Eps lanaueds ul eilcice user-defined 
type WORK_AGE is range 18 .. 65; 
type VOLTAGE is delta 0.25 range 100.0 .. 500.0; 
type SPEED is range 0 .. 3000; 
subtype AUTO_SPEED is SPEED range 0 .. 250; 
subtype LEGAL_SPEED is SPEED range 0... 65; 
type AIRCRAFT is (FRIEND, FOE, UNKNOWN) 
type GENDER_TYPE is (MALE, FEMALE); 


type PERSONNEL_RECORD is 
record 


NAME : STRING (1 .. 30); 
AGE : WORK_AGE; 
GENDER : GENDER_TYPE; 


end record; 


’ 
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Packaging 


«  Anencapsulation mechanism 


¢ — Allows client (user) to focus on the functionality 
of a resource without worrying about its actual 
implementation 


Ada Subprogram Ada Package 


N\ STACK 


MAIN 
Implementation 
details for 
stack 
oe The Resource 
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Exception Handling 


* An exception is a signal that something has gone 
wrong (divide by zero, out-of-range value, etc.) 


¢ An Exception handler is a portion of code that is 
executed when an error occurs within the 
associated sequence of statements 


* Exceptions not handled are ‘propagated’ outward 


ren 
IJ,K : i= 0; 
An Ada declarative begin 
Subprogram sequence th 
of Jocs 17; 

statements | t= J/K; 

exception Ge SS eee 

handiere exception 

when NUMERIC_ERROR => 
end SAMPLE; 
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Separate Compilation 


* The library (an integral part of the language) contains 
compilation units 


* Compilation units can be submitted for compilation 


separately and the library will maintain a history of 
information 


* Compilation units form a partial ordering within the 


library 
S MAIN P 
[ fsa 
iain 
re Se 
A subunit A procedure A package 
Compilation units 
( ———+ Indicates an order dependency) 


THE SPEC OF THE THE SPEC OF THE THE BODY OF THE 
PROCEDURE MAIN PACKAGEP JP | packAGEP 
THE BODY OF THE THE SUBUNIT S 

PROCEDURE MAIN (FROM MAIN) 
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Generics 


* Ahigh-order language ‘macro’ 


* Allows similar subprograms and packages 
to be created from a template (generic unit) 


STACK_GENERIC 


Generic Instantiation 


package INTEGER_STACK Is new STACK_GENERIC (ELEMENT_TYPE => INTEGER); 
package FLOAT_STACK is new STACK_GENERIC (ELEMENT_TYPE => FLOAT); 
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+ Ada provides a model of concurrency which 
is completely defined in the high-order language 


* Reliance on operating system resources is 
not required 


CONCURRENCY 


68 
LI 47 \ |b 


Traditional approach Ada approach 
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Software Engineering Principles 
and Ada 


Ada allows decisions based on Software Engineering 
Principles to be explicitly reflected in compilable code, 
permitting automatic checking. 


* Software Engineering Principles 
e« Abstraction 
e¢ Information Hiding 
e* Encapsulation 
*« Modularity 
+ Features key to reflecting these principles 


»« Ada's program units ai ties oh packages, 
tasks and generics) help implement these principles 


+ Ada’s scope and visibility rules help enforce 
these principles 
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Software Engineering with Ada See LE 


SOFTWARE ENGINEERING GOALS 


MODIFIABILITY 


-- Controlled change ; 
-- Logical invariance to physical change 
~ Solution space maps the problem space 


EFFICIENCY 


-- Time/space tradeoff : 

-- Microefficiency often considered too early : 

-- Macroefficiency achieved by unified understanding 
of the problem 


RELIABILITY 

-- Prevention of failure 

-- Recovery from failure 

-- Often considered too late 
UNDERSTANDABILITY 

- Many different views to deal with 


-- ‘Golden rule’ of software applies 
-- Code is written once but is read far more 


often than that 
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Abstraction 


The process of identifying the important properties 
of the phenomenon being modeled and ignoring 
(for the moment) the underlying details. 
* Each level of decomposition represents 
an abstraction 


* Each level must be completely understood 
as a unit 


+ Abstraction applies to data as well as to algorithms 


* Facilitates mapping from problem space to 
solution space 
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Information Hiding eetecion a? 5 


: : i ion i ib! A STACK is an abstract object with abstract 
Make details of an implementation inaccessible operations PUSH and POP (among others). 
@ user of a stack ought not be concerned 
about how the object (or the operations) are 


+ Focus on the abstraction of an Pere by implemented. 
suppressing the underlying details 


* Enforce defined interfaces 


+ Prevent high-level decisions from being based 
on low-level characteristics 


TOP 
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System Interfaces Software Interfaces 
¢ Awall engineered system will most often * Outside View The outside view provides the 
consist of a collection of layered interfaces « Abstract View abstraction of the interface and 
* Functional View | does not concern itself with how 
* Client View the features of the interface are 
« Schema actually implemented 


NTERFACE 


INTERFACE (1 
. loki View — inermation ih ae side et hg 
: « Implementation | interface is hidden from the client. 
INTERFACE (i * Detailed View The client must rely only on the 
information contained in the 

INTERFACE (i+1 outside view 
EBEACEQ Me aaa Ot et a cea 

4 INTERFACE H 


Notice that the implementor (of the inside view) of 
one interface is likely the client (with outside view) of 
another interface. 


30 


Software Engineering with Ada 29 Software Engineering with Ada 
Ada Interfaces Object-Oriented Design 


IMPLE 
+ All Ada program units (subprograms, packages, Se as SOLUTIONS 
tasks and generics) are composed of two parts 


** The specification is the outside view and provides 
the abstraction of the resource 


: COMPLEX 
*« The body is the inside view and provides the PROBLEMS 


implementation of the resource 


‘COMPLEX 
SOLUTIONS 


1 
2 
3 
4 


i ificati 1. Ideal academic situation 
*  Theclient of the resource sees only the specification. 1 Mes otademn este 


The client can never see "inside" the body of the Foe cee araconrized conpleddy-or 
sei ce better appreciation of problem space 
4. Real world situation (usually) 


+ Therefore, the body can enetge radically and, as long 
as the specification is still implemented, the client is 
unaffected by the change 


PROBLEM SOLVING 


PROBLEM SPACE SOLUTION SPACE 


THE 
MACHINE 
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Gbject Orie hie Design Object-Oriented Design 
‘ si . A means of mapping problem-space ‘objects’ 
Ada permits a near-verbatim implementation of an Pi jects’ onto 
Object-oriented Design, Gennitthog automatic checking. solution-space constructs 
* Object-oriented Design An Object 
* Has state 


«« Objects 
* Is characterized by its operations 


«+ Operations 
p «« Constructors - change state 


ee Interface 
++ Selectors - report state 


e« Errors in operations * Has restricted visibility of and by other objects 


+ Features key to implementing an * Can be viewed in two ways 
object-oriented design 


: *- By its specificati i i 
+» Packages and Generics implement objects eee ation (outside, abstract view) 


; «+ By its implementation (insi i ‘ 
+»  Subprograms implement operations . “4 ation (inside, detailed view) 


; * Is adistinct (perhaps uni i 
ee Exceptions map problem-space errors ® Sa ec pane enive eens 


discovered while executing operations 
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Object-Oriented Design Object-Orientation and Ada 


Identify the objects Overhead Projector - 

Identify the operations Constructors Object Package or generic package 
Turn_On Outside View Package Specification 
Turn_Off 
eet e_Bulb Inside View Package body (and private part) 

jug_In 
Focus Constructor Procedure (Usually) 
Selectors Selector Function (Usually) 

Projector_is_on 
Bulb_is_burnt_out Errors in Operations Exception 
Is_plugged_in 
Weight Object Class Package with private type 

Establish Interface (Outside view) Abstract Object Package 

Implement the object (Inside view) Names of Objects Variables 

Decide on implementation of state State (object class) In instance of private type 


Implement each operation State (Abstract Object) —_ In package body 
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An Example of an Ada Object An Example of an Ada Object 
Package Spec with BULB_DATA, MEASURES; 
(Outside View) package OVERHEAD ) PROJECTOR i is 
procedure TURN ON 
OVERHEAD PROJECTOR procedure TURN_OFF 
procedure ue BULB (B : in BULB_DATA.BULB); 
procedure 
tnaise View)” procedure PLUG | iN; 
State (data structure) 
Constructors BULB F i function IS_ON return BOOLEAN; 
fbpsccres teen function IS_PLUGGED_IN return BOOLEAN 
go here function WEIGHT return MEASURES. WEIGHT _TYPE; 


BAD_BULB : exception; 


Selectors pens end OVERHEAD_PROJECTOR; 


Exception BAD_BULB 
package body OVERHEAD_PROJECTOR is 


_. pe PROJECTOR_TYPE is 
HE_PROJECTOR : PROJECTOR TYPE; 


procedure TURN_ON is 
gin 


end TURN_ON; 


end OVERHEAD_PROJECTOR; 
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Alternative Solutions to Problems 
and their impact on Software Goals 


Ada offers many solutions to any problem, and selection 
of which solution to use is frequently determined bi 
high-level goals. Understanding trade-offs is thus key 


Software goals 

ee Performance 

ee Portability 

«« Reuse and Reusability 
*« Testability 

e+ ~Maintainability 

*« Reliability 


«« Problem Domain Fidelity 

*« Robustness 

«« Recompilation Efficiency, Etc. 

Features key to goal achievement 

*« Type selection 

ee Tasking implementation 

«+ Generics 

*» Reliance on data structures vs statements 


*» Separate compilation, Etc 
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Technology 


Hardware 
Life-cycle Methodologies 
Software Tools and Environments 


Reuse Technology 


Software Engineering with Ada SS 
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Executive Overview 


+ Motivation, History, Strategy 
«= Software Crisis 
«= Software for Embedded Computer Systems - 1974 
+ Components of the Implementation of the Strategy 
ee Why a New Language? 
+» Three Legs to the Language 


+. Ada continues the tradition 


+ Themes & Examples 


= Effective use of Ada 
«= Software Engineering Principles and Ada 
ee Object-Oriented Design and Ada 


Alternative Solutions to Problems and 
their Impact on Software Goals 


» Emerging Software Scene 
« Technology 


+» Human Resources 
«- Business Practices 


+ Applications 
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Human Resources 


Shortage of Qualified Ada personnel 
Professional Standards 
Training 


Experience 


Nl 
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Coa 
Programming Language Policy” 


* Closer Control and visibility are possible 
Signed 2 APR 1987 
* New methods need tolerance and encouragement 
(1) Ada shall be the single, common, computer 


« Reuse technology will increase build/buy options programming language for Defense computer 
resources used in intelligence systems, for the 
+ Dod Policy command and control of military forces, or as 


an integral part of a weapon system. 


(2) Programming languages other than Ada 
that were authorized and being used in full-scale 
development may continue to be used through 
deployment and for software maintenance, 

but not for major software upgrades. 


(3) Ada shall be used for all other applications, 
except when the use of another approved higher 
order language is more cost-effective over 

the application's life-cycle. 


(4) DoD-Aproved Higher Order Programming Languages 


- Ada * FORTRAN 
¢ C/ATLAS ¢ JOVIAL(J73) 
* COBOL ¢ Minimal BASIC 
* CMS-2M * Pascal 
°  CMS-27 «+ SPL 
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DODD 3405.2 "Use of Ada in 
Weapon Systems" Applications 


Signed 30 MAR 1987 
+ Ada in Europe 
(1) Ada shall be the single, common, high-order 


programming language, effective immediately; ¢ Non-DoD Ada Experience 
(2) use of validated Ada compilers is required; and ¢ Real-Time 

(3) an Ada-based program design language ees shall be > MIS 

used during the designing of software. Use of a PDL 


that can be successfully compiled by a validated Ada 
compiler is encouraged in order to facilitate the portability 
of the design. 
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Ada In Europe 


Used in all NATO military systems 
as/of January 1, 1986 


Several validated Ada compilers 


Compiler implementations by UK, Denmark, 
France, West Germany, Finland, USSR 


Ada adopted as an ISO standard (12 Mar 87) 


Denmark and Spain jointly writing queuing 
software (first European commercial venture) 


Denmark and France jointly writing FAA S/W 
UK adopts Ada in favor of CORAL 


Germany accepts only Ada and PEARL for embedded 
systems 


Sweden mandates Ada for Real-time systems effective 
January 1987 


Used for two major Finnish banking systems (2M LOC) 


Many Ada textbooks written by Europeans 


+ Joint Sweden, Denmark, Finland navy project 
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Ada Information Clearinghouse 


GENERAL INFORMATION SERVICES 


-- On-line Ada-Information directory 
-- Staff available for phone queries 
-- Information mailings 


AdalC NEWSLETTER 


CATALOG OF RESOURCES FOR EDUCATION IN ADA 
AND SOFTWARE ENGINEERING (CREASE) 


ADAIC INFORMATION 


-- Ada Bibliography 

-- Documents Reference List 
-- Validated Compiler List 

-- Ada Implementations List 
-- Classes and Seminars 

-- Conferences and Programs 
-- Textbooks 

-- Calendar of Ada Events 


Ada Information Clearinghouse 
4550 Forbes Blvd., Suite 300 
Lanham MD 20709 

(301) 731-8894 

(703) 685-1477 
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Non-DoD Ada Experience 


¢ CBT system (McDonnell-Douglas) 

+ Business Software (Intellimac) 

+ Communications (Singer-Librascope) 

+ Industrial Process Control (MOOG) 

* Artificial Intelligence (Intellimac) 

« NASA commitment -- manned space station 
+ CCA -- Distributed Relational Database 


* Oil industry -- geophysical software 


° FAA 
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Technical Overview 


+ — Ada's Requirements and Design 
+ Ada From the Top Down 
*« Subprograms 
«Tasks 
«« Packages 
*« Generics 
«« Separate Compilation 
* Ada From the Bottom Up 
* Character Set 
e+ Reserved Words 
«Types 
+ Statements 


«Representation Specifications 
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Ada DESIGN GOALS 


* RECOGNITION OF THE IMPORTANCE OF PROGRAM 
RELIABILITY AND MAINTAINABILITY 


+ CONCERN FOR PROGRAMMING AS A HUMAN 
ACTIVITY 


* EFFICIENCY 


“We must recognize the strong and undeniable influence 
that our language exerts on our way of thinking and in 
fact defines and delimits the abstract space in which we 
can formulate - give form to - our thoughts.” 


— Nicklaus Wirth, 1974 
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What kind of language is Ada? 


* an algorithmic language 


-- subprograms (functions and procedures) 
-- structured control statements 
-- complete data structuring capability 


a design language 


-- packages, tasks, subprograms for decomposition 
-- separate compilation for top-down design 

-- library units for bottom-up design 

-- generic units for reuseability 


a systems programming language 


-- tasking for concurrent processes 

-- representation specs for ‘bit twidling’ 
-- exception handling 

-- hardware interrupt recognition 


an extendable language 


-- can be tallored to a given application area 
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STEELMAN REQUIREMENTS 


« STRUCTURED CONSTRUCTS 

* STRONG TYPING 

* RELATIVE AND ABSOLUTE PRECISION 

* INFORMATION HIDING AND DATA ABSTRACTION 
* CONCURRENT PROCESSING 

« EXCEPTION HANDLING 

¢ GENERIC DEFINITION 

¢ MACHINE DEPENDENT FEATURES 
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PROGRAM UNITS 
(Ada from the top) 


*« SUBPROGRAMS 


-- Functions and Procedures 
-- Main program 
-- Abstract operations 


TASKS 


-- Parallel Processing 
-- Real-Time 
-- Interrupt Handling 


PACKAGES 


-- Encapsulation 
-- Information Hiding 
-- Abstract Data Types 


GENERICS 


-- Packages and subprograms ;. 
-- HOL macro e 
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TRADITIONAL 


SOURCE 
CODE 


COMPILE 
OBJECT 
CODE 


OBJECT 
CODE 


LOAD 
MODULE 
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ALL Ada PROGRAM UNITS 


* The SPECIFICATION (outside view) is the contract 
or interface between the user of the unit and the 
implementor of the unit. ft represents only "What" 


is to be done, not "how". 


¢ The BODY (inside view) is the "how" of the unit. Its 
details are the responsibility of the implementor. 
The user of the unit need not (and should not) know 


these details, 
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SOURCE 


CODE 
COMPILE 


LOAD 
MODULE 


EXECUTE 


Ada approach 


PROGRAM 
LIBRARY 


OBJECT 
CODE 
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Ada SUBPROGRAMS 


Specification 


hidden Body 


PROCEDURES 


-- Perform some “sub-action" 
-- Call always appears as a statement 


FUNCTIONS 
-- Calculate and retum a value 
-- Call always appears in an expression 
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PARAMETER PASSING MODES 


IN - The formal parameter acts as a local constant. 
Assignment (definition) is not allowed. 


OUT - The formal parameter holds a ‘created’ value. 
Reference is not allowed. 


IN OUT - The formal parameter can be both assigned 
to (defined) and referenced. 


* The default mode is IN 
¢ Functions may have IN parameters only 


; 
Called unit 


Calling unit | <——- OUT 


IN———> 


<— INOUT——> 
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Ada FUNCTIONS 


-- FUNCTION SPECIFICATION 


function SQRT (ARG : FLOAT) return FLOAT; 


-- FUNCTION CALL 


-- assuming STANDARD_DEV and VARIANCE are 
-- of type float: 


STANDARD_DEV := SQRT (VARIANCE); 


-- FUNCTION BODY 


function SQRT (ARG :FLOAT) return FLOAT is 
RESULT : FLOAT; 
begin 
-- algorithm for computing RESULT goes here 
return RESULT; 


end SQRT; 
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———————— 


Ada PROCEDURES 


-- PROCEDURE SPECIFICATION 
procedure SWAP (PRE, POST : in out INTEGER); 


-- PROCEDURE CALL 


SWAP (MY_COUNT, YOUR_COUNT); 
SWAP (PRE => MY_COUNT, POST => YOUR_COUNT); 
SWAP (POST => YOUR_COUNT, PRE => MY_COUNT); 


-- PROCEDURE BODY 


procedure SWAP (PRE, POST : in out INTEGER) is 
TEMP : INTEGER := PRE; ___ -- local object declaration 
begin 
PRE := POST; 


POST := TEMP; 
end SWAP; 
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BLOCK STRUCTURE 
DECLARATIONS 


J: INTEGER; 
K: INTEGER; 


J: INTEGER; 
F: FLOAT; 


EXCEPTION HANDLERS 
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Ada PACKAGES 


SPECIFICATION BODY 


* The PACKAGE is the primary means of 
"extending" the Ada language 


* The PACKAGE hides information in the 
body thereby enforcing the abstraction 
tepresented by the specification 


+ Operations (subprograms, functions etc.) whose 
specification appear in the package specification 
must have their body appear in the package body. 


. 


Other units (subprograms, functions, packages etc.) 
as well as other types, objects etc. may also appear in 
the package body. If so, they are not visible outside 


the package body. 
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PACKAGE USAGE 


MAIN 


with RUBIK, TEXT_IO; 
procedure MAIN is 


MY_CUBE : RUBIK.CUBE; 
begin 

RUBIK.GET eigen ern 

RUBIK.SOLVE (MY. F OLE 

RUBIK.DISPLAY (MY_CUBE); 
exception 


when RUBIK.BAD_CUBE => 
TEXT_IO.PUT_LINE (“You got a bad one”); 


end MAIN; 


. 
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Ada PACKAGES 


-- PACKAGE SPECIFICATION 
package RUBIK is 


type CUBE is private; 
procedure GET (C : out CUBE); 
procedure SOLVE (C :in out CUBE); 
lure DISPLAY (C : in CUBE); 
AD_CUBE : exception; 


mo-HAaco 


private 
type CUBE is... -- Actual type definition goes here 
end RUBIK; 
-- PACKAGE BODY 
package body RUBIK is 
— all bodies of subprograms found in the 
-- package spec go here along with any 
-- other local declarations that should 
~ be kept "hidden" from the user. 
procedure GET (C : out CUBE) is... 
procedure SOLVE (C : in out CUBE) is... 
procedure DISPLAY (C : in CUBE)is... 


end RUBIK; 
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Package MEASURES is 
type AREA _ is private; 
type LENGTH is private; 


function “+* (LEFT, RIGHT : LENGTH) return LENGTH; 
function **" (LEFT, RIGHT : LENGTH) return AREA; 


_ NUMBER_TOO_LARGE : exception; 
private 
type AREA is range 0. . 10000; 
ape LENGTH is range 0. . 100; 
end MEASURES; 


~ specification 


with MEASURES; 
procedure MEASUREMENT is 


SIDE_1, SIDE_2 : MEASURES. 4 
FIELD : MEASURES.AREA; ee 


use MEASURES; _-- allow direct visibility 
bagin 
FIELD := SIDE_1 * SIDE_2; 
exception 
when NUMBER_TOO_LARGE =>... 
end MEASUREMENT; 
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a a a 
THE ULTIMATE IN INFORMATION HIDING 


THE TRADITIONAL 
(08) MODEL OF 
CONCURRENCY 


THE Ada 
TASKING 
MODEL 
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TASK COMMUNICATION 


TASK_1 TASK_2 


: 


+ TASK SPECIFICATIONS 
task TASK_1; ___-- no entries 
task TASK _2 is 


entry XMIT (N : in INTEGER); 
end TASK_2; 


-- TASK BODIES 


task body TASK_1 is 

TASK_2.XMIT (17); -- an entry call 
end TAS K_1; 
task body TASK_2 is 

accapt XMIT (N : in INTEGER) do 

pa -- statements to be executed 

-- during rendezvous 
end XMIT; 


end TASK_2; 
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SPECIFICATION (OUTSIDE) 


x 
Lentry | 
[entry] 4—— BODY (INSIDE) 


« The TASK concept in Ada provides a model of 
parallelism which encompasses: 


-- Multicom puters 
-- Multiprocessors 
-- Interleaved Execution 


¢ In Ada, the method of communication between 
tasks Is known as "rendezvous" 


« Ada “draws up” into the language certain capabilities 
previously performed only by the operating system 
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. 
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SEPARATE COMPILATION 


PACKAGE, TASK AND SUBPROGRAM BODIES CAN BE 
COMPILED SEPARATELY FROM THEIR 
SPECIFICATIONS 


THE INDICATOR OF SEPARATE COMPILATION IS 
KNOWN AS A'‘STUB' 


THE SEPARATELY COMPILED BODY IS KNOWN AS 
A‘SUBUNIT: 


THE UNIT WHICH CONTAINS THE 'STUB' IS KNOWN 
AS THE 'PARENT’ 


ENTITIES VISIBLE TO THE 'STUB' ARE ALSO 
VISIBLE TO THE 'SUBUNIT' 


COMPILATION UNIT DEPENDENCIES 


1, PARENT UNITS ARE COMPILED BEFORE THEIR SUBUNITS 
(Recompiling the parent requires recompiling the subunit) 


2. SPECIFICATIONS ARE COMPILED BEFORE THEIR BODIES 
(Recompiling the specification requires recompiling the body) 


3. REFERENCED LIBRARY UNITS ARE COMPILED BEFORE 
ANY UNITS WHICH REFERENCE THEM (Recompiling the 
referenced unit requires recompiling the unit which references it) 
with P; 

procedure MAIN is 


procedure S is separate; 


begin MAIN P (body) 
end MAIN; 
separate (MAIN) 


procedure S is 
begin 
end S; 
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SEPARATELY 
COMPILED 


A 


TEXTUALLY 
NESTED 


A 


procedure A( )is 
procedure B( )is 
begin 
endB; 

begin 

end A: = 
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procedure A ( ) is 
"procedure B ( ) is separate; 


separate (A) 
procedure Bi ) is 


begin 
end B; 
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Se 
Ada FROM THE BOTTOM UP 


« CHARACTER SET 
-- All Ada constructs are built from the ASCIl character set 
* LEXICAL UNITS 
~ Identifiers COUNT, peo 
~ Numeric Literals 17, 3.5, 8#77#) 
-- Character Literals ‘Aa By) 
-- Strings "This is a string") 
-- Delimiters &, +, 1, <>, => 
-- Comments 
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Ada TYPES 


* A Type is a template for objects; it represents a 
set of values which are meaningful for the objects 
and also a set of operations on the objects (values) 


* Ada is a strongly typed language. This means that 
all objects must be declared and objects of different 
types cannot be Implicitly mixed in operations 


* TYPES are not operated upon directly. They are a 
means of declaring instancas called OBJECTS. These 
objects can be operated upon. 


i] <+— OBJECTS 
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Ada RESERVED WORDS 


abort declare generic 
abs delay goto 
accept delta 
access digits 
do 


of select 

or separate 
others subtype 
out 


all if 
and in 
array is package task 
at else pragma terminate 
alsif limited private then 
end loop procedure type 
en 
exception 
begin exit mod raise use 
body range 
record when 
rem while 
new renames with 
case for not return 
constant _ function null reverse xor 
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Ada TYPES 


SCALAR 
COMPOSITE 


PRIVATE 


objects are 
single values 


objects contain 
other components 


objects are 
‘abstract’ 


objects ‘point’ to 
other objects 


objects are 
parallel processes 
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SCALAR TYPES 
DISCRETE REAL 
INTEGER [ENUMERATED | ___ FIXED FLOAT 


integer boolean duration float 
natural character 
positive 


ee §=9USER DEFINED 9 =e 
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COMPOSITE TYPES 


ARRAY TYPES DESCRIBE COLLECTIONS OF 
HOMOGENEOUS COMPONENTS. INDIVIDUAL 
COMPONENTS ARE SELECTED BY DISCRETE 
INDEX. 


RECORD TYPES DESCRIBE COLLECTIONS OF 
HETEROGENEOUS COMPONENTS. INDIVIDUAL 
COMPONENTS ARE SELECTED BY FIELD 
IDENTIFIER. 
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ENUMERATION TYPE DECLARATIONS 


type COLOR is (WHITE, RED, YELLOW, GREEN, BLUE); 
type LIGHT is (RED, AMBER, GREEN); 

type GEAR_POSITION is (UP, DOWN, NEUTRAL); 

type SUITS is (CLUBS, DIAMONDS, HEARTS, SPADES); 
subtype MAJORS is SUITS range HEARTS . . SPADES; 
type BOOLEAN is (FALSE, TRUE); -- predefined 


ENUMERATION OBJECT DECLARATIONS 


HUE : COLOR; 

SHIFT : GEAR_POSITION := GEAR_POSITION'LAST; 
T : constant BOOLEAN := TRUE; 

HIGH : MAJORS := CLUBS; -- invalid 


HUE SHIFT T 
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CONSTRAINED ARRAYS 


type TABLE is array (INTEGER range 1 .. 5) of FLOAT; 
MY LIST : TABLE i= (3.7, 14.2, “65, 0. : ; 


type DAYS is (SUN, MON, TUE, WED, THU, FRI, SAT); 
type WEEK_ARRAY is array (DAYS) of BOOLEAN; 


T : constant BOOLEAN := TRUE; 
F : constant BOOLEAN := FALSE; 


MY_WEEK : WEEK_ARRAY := (MON .. FRI => T, others => F); 


MY_WEEK 


a kon — 


Hi SL ais 
i HU) = true then... 
if MY_WEEK (THU then. me 
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UNCONSTRAINED ARRAYS 


+ INDEX TYPE AND COMPONENT TYPE BOUND TO 
ARRAY TYPE 


* INDEX RANGE BOUND TO OBJECTS, NOT TYPE 
« ALLOWS FOR GENERAL PURPOSE SUBPROGRAMS * 


type SAMP Is array (INTEGER range <) of FLOAT; 


LARGE : SAMP (1 .. 5) = (2.5, 3.4, 1.0, 0.0, 4.4); 
SMALL : SAMP (2.4) := (2..4 => 5.0); 


SMALL 


&whND 
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ACCESS TYPES 


(Memory Allocation) 


type NODE; 
usen1 | 1 J 


type PTR is access NODE; 


type NODE is : 
record 

FIELD_1: SOME_TYPE; 
FIELD_2: BLAH; 
FIELD_3: FOO; 
FIELD_4: FRAMUS; THE 
FIELD_5: PTR; HEAP 

end record; 


USER 2 


TOP :PTR; -- an access object 


TOP := new NODE; --an allocator 


TOP.FIELD_5 := new NODE; -- another allocator 


RECORD TYPES 


- Record type declaration 
type DATE is 


record 
DAY : INTEGER range 1 .. 31; 


MONTH : MONTH_TYPE; 
YEAR — : INTEGER range 1700 .. 2150 


end record; 

~ Record object declaration TODAY 
TODAY : DATE; 

~ Record component reference 


TODAY.DAY 4; 
TODAY.MONTH := JUL; 
TODAY.YEAR = := 1776; 


- Record object reference 
TODAY := (4, JUL, 1776); 
-or- 
if TODAY /= (6, DEC, 1942) then... 
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Ada Statements 


SEQUENTIAL 


CONDITIONAL ITERATIVE 


TASKING OTHER 


DELAY 
ENTRY CALL 
ABORT 


ACCEPT 
SELECT 
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Ada STATEMENTS 


-- To exemplify some of the Ada statements, 
-- consider the implementation of a ‘wrap-around! 
-- successor function for type DAYS. 


procedure TEST is 


type DAYS is (SUN, MON, TUE, WED, THU, FRI, SAT); 


TODAY, TOMORROW : DAYS; 
function WRAP (D : DAYS) retum DAYS is... 


begin 
TOMORROW := WRAP (TODAY); 
end TEST; 
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function WRAP (D : DAYS) return DAYS is 
begin 


case Dis 
when SUN => retum MON; 
when MON => return TUE; 
when TUE => retum WED; 
when WED => return THU; 
when THU => retum FRI; 
when FRI => retum SAT; 
when SAT => retum SUN; 


end WRAP; 
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function WRAP (D : DAYS) retum DAYS is 


begin 
if D = SUN then 


retum MON; 
elsif D = MON then 
a ‘ 


elsif o FRI Hen 
im SAT; 
go 
retum SUN; 
if; 


end WRAP; 


Software Engineering with Ada 74 


function WRAP (D : DAYS) return DAYS is 
WEEK: ary Ue Wet of DAYS := 


(MON, TUE, WED, THU, FRI, SAT, SUN); 
begin 
WEEK 
retum WEEK (D); SUN 
end WRAP; MON 


TUE 
WED 
THU 
FRI 
SAT 
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function WRAP (D : DAYS) return DAYS is 
begin 
return DAYS'SUCC (D); 
exception 
when CONSTRAINT_ERROR => 
retum DAYS'FIRST; 
end WRAP; 
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function WRAP (D : DAYS) retum DAYS is 
begin 
If D = DAYS'LAST then 
retum DAYS'FIRST; 
alse 
ratum DAYS'SUCC (D); 
end if; 
end WRAP; 
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function WRAP (D : DAYS) return DAYS is 
begin 
if D = SAT then 
retum SUN; 
else 
return DAYS'SUCC(D); 
end if; 
end WRAP; 
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Consider the following integer type declaration: 
type SIZE is range 1. . 10; 


Suppose you wanted a wrap-around successor 
capabllity for this type. That is, the successor of 
the value 10 would be the value 1. 


What changes would need to be made to the previous 
example in order to provide this capability? 
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GENERIC UNITS 


GENERIC SPECIFICATION 


generic 
type ELEMENT Is (> 
function WRAP_AROUND Yo: ELEMENT) return ELEMENT; 


GENERIC BODY 
function WRAP_AROUND (D : ELEMENT) return ELEMENT Is 
begin 
if D = ELEMENTLAST then 
eum ELEMENTFIRST; 


ian ELEMENT'SUCC (D); 
end if; 
end WRAP__ AROUND; 


N TI 


function WRAP Is new WRAP_AROUND (ELEMENT => DAYS); 
function WRAP Is new WRAP_AROUND (ELEMENT => SIZE); 
function WRAP Is new WRAP_AROUND (CHARACTER); 


-- NOTE: The identifiers of the instantiations 
need not be o 
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A package dealing with digital representations 
of numbers: 


444 


package DIGITAL_INFO is 


type LIGHT_POSITION eee UL, UR, M, LL, LR, B); 
type LIGHT_STATUS is (OFF, ON) 


type DIGITAL_VALUE is array (LIGHT_POSITION) 
of LIGHT_STATUS; 


type DECIMAL is range 0 .. 9; 


function CONVERT (NUM : DECIMAL) 
return DIGITAL_VALUE; 


+- other resources could go here 
end DIGITAL_INFO; 


e 
— 1 [on 
uL [OFF 
“|, UR un Ton 
pee m [on 
LL [OFF 

Ltr [ON 
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WRAP_AROUND 


GLITITTS, 
ee, ~ 
uC RAP 


Tab 


aes - (SIZE) 
put t . b')); 


TOMORROW := to 4 


If CURRENT_SIZE >= WRAP(NEW_SIZE) then 
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package body DIGITAL_INFO is 
function CONVERT (NUM : DECIMAL) return DIGITAL_VALUE Is 


begin 

case NUM Is 
when 0 => return (M => OFF, others => ON); 
when 1 => return (UR | LR => ON, others => OFF); 
when 2 => return (UL | LR => OFF, others => ON); 
when 3 => return (UL | LL => OFF, others => ON); 
when 4 => return (T | LL | B => OFF, others => ON); 
when 5 => return (UR | LL => OFF, others => ON); 
when 6 => return (UR => OFF, others => ON); 
when 7 => return (T | UR| LR => ON, others => OFF); 
when 8 => return ( others => ON); 
when 0 => return (LL | B => OFF, others => ON); 

end case; 


end CONVERT; 


++ bodies of other units go here 
end DIGITAL_INFO; 
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Allow the user to turn a warning [ight on and off. The 
light Is mapped Into HEX location 100. _If the first 
elght bits of that location are set to all ones, the light 
will be on. ff the first elght bits are set to all zeroes, the 
light will be off. There are no guarantees relative to 
any other configuration. 


package LIGHT is 
procedure TURN_ON; 
rocedure TURN_OFF; 
end LIGHT; 


package body LIGHT is 


type STATUS is (OFF, ON); 

for STATUS'SIZE use 8; 

for STATUS use (OFF => 16#00#, 
ON => 16#FF#); 

WARNING : STATUS := OFF; 

for WARNING use at 16#100#; 


proceuns TURN_ON Is 
egin 


WARNING := ON; 
end TURN_ON; 


cocecurs TURN_OFF Is 
egin 

WARNING := OFF: 
end TURN_OFF; 


end LIGHT; 
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INPUT 


DEAR MOM: HAPPY BIRTHDAY! LOVE, TIM ZZZZ 
DAD: SEND MONEY. JOE Z22Z MR. PRESIDENT: 
PLEASE RESTORE THE BUDGET FOR STARS. 


VANCE DRUFFEL 22ZZ DEAR ELIZABETH: BEST 


WISHES ON YOUR LATEST MATRIMONIAL TRY. 
J. WARNER ZZZZ DEAR J. GO TO H---!_E. T. 
ZZZZ DEAR GEORGE: GO FOR ITI J. I. Z2ZZ 
DEAR JEAN: ROSES ARE RED; VIOLETS ARE 
BLUE; ADA IS GREEN. D. F. Z2ZZ DEAR 007: 
009 HAS BEEN ASSASSINATED; YOUR NEW 
CONTACT IS 008. CONTROL ZZ2Z 


Telegram number 
Telegram number 
Telegram number 
Telegram number 
Telegram number 
Telegram number 
Telegram number 
Telegram number 


1 contains 6 words. 
2 contains 4 words. 


3 contains 10 words. 
4 contains 11 words. 
S contains 7 words. 
6 contains 7 words. 
7 contains 13 words. 
8 contains 12 words. 


END OF REPORT 
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DESIGN EXAMPLE 


COUNT THE NUMBER OF WORDS IN EACH OF A 


SEQUENCE OF TELEGRAMS. 


(From George Cherry's book “Parallel Programming 
in ANSI Standard Ada’) 


An input file contains the text of a number of telegrams. 
Each telegram consists of a number of words followed by 
the word "ZZZZ". 


The input file is composed of a sequence of lines. The lines 

can vary in length; but the length of a line cannot exceed 40 

characters. Each line contains a number of words, separated 
blanks. ~ 


The length of a word cannot exceed 26 characters. There may 
be one or more blanks between adjacent words; and there may 
be one or more additional blanks at the beginning and end of 
aline. 


There Is no particular relationship between telegrams and 
lines: a telegram may begin and end anywhere in a line and 
may span several lines. Furthermore, several telegrams may 
share a line. 


The problem is to analyze the set of telegrams and print a 
report, showing for each telegram its ordinal number and the 
number of words it contains. Of course, the special “word” 
“Z2Z2Z" should not be counted as a word in the statistics. 
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INFORMAL STRATEGY 


A COLLECTION OF TELEGRAMS IS A SEQUENCE OF 
WORDS WITH SPECIAL SIGNAL WORDS INSERTED 
AT THE END OF EACH TELEGRAM. WHILE WORDS 
REMAIN, GET A WORD AND, IF fT IS NOT A SIGNAL 
WORD, INCREMENT THE COUNTER ASSOCIATED 
WITH THE TELEGRAM. IF THE WORD IS A SIGNAL 
WORD, OUTPUT THE COUNT OF WORDS AND CLEAR 
THE COUNTER. WHEN THERE ARE NO MORE 
WORDS, OUTPUT AN APPROPRIATE MESSAGE. 


OBJECTS AND OPERATIONS 


TELEGRAM COLLECTION 

- GET NEXT WORD 

-- WORD IS SIGNAL 

-- COLLECTION IS DEPLETED 
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COUNT_WORDS_IN_TELEGRAMS 


TEXT_IO 
[Pur] 
[set 
[ess] 
TELEGRAM_COLLECTION 
("word __) 
TELEGRAM_FILE 
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with TELEGRAM_COLLECTION, TEXT_!0; 
procedure COUNT_WORDS_IN_TELEGRAMS Is 


TELEGRAM_NUMBER : NATURAL := 0; 


WORD_COUNT NATURAL := 0; 
CURRENT_WORD : TELEGRAM_COLLECTION. WORD; 


package INT_IO Is new TEXT_IO.INTEGER_IO (INTEGER); 


procedure OUTPUT_COUNT (NUMBER, COUNT : NATURAL) 
is separate; 


begin 
loop 
exit when TELEGRAM_COLLECTION.IS_DEPLETED; 
TELEGRAM_COLLECTION.GET(CURRENT_WORD); 
if TELEGRAM_COLLECTION.IS_SIGNAL(CURRENT_WORD) then 
TELEGRAM_NUMBER :x TELEGRAM_NUMBER + 1; 
OUTPUT_COUNT (TELEGRAM_NUMBER, WORD_COUNT); 
WORD_COUNT := 0; 
else 
WORD_COUNT := WORD COUNT + 1; 
end Ht; 
end loop; 
TEXT_IO.PUT_LINE(” END OF REPORT"); 
end COUNT_WORDS_IN_TELEGRAMS; 
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OBJECT SPECIFICATION 


package TELEGRAM_COLLECTION is 
type WORD Is private; 
procedure GET (THE_WORD : out WORD); 
function IS_DEPLETED retum BOOLEAN; 


function IS_SIGNAL (THE_WORD : WORD) 


return BOOLEAN; 
private 
type WORD is... 
end TELEGRAM_COLLECTION; 
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separate (COUNT _WORDS_IN_TELEGRAMS) 
procedure OUTPUT_COUNT (NUMBER, COUNT : in NATURAL) is 


begin 
TEXT_IO.PUT ("Telegram number"); 


INT_IO.PUT (NUMBER,2); 
TEXT_IO.PUT (" contains "); 
INT_IO.PUT (COUNT,2); 
TEXT_IO.PUT (" words."); 


end OUTPUT_COUNT; 


soaetnng: 


a 
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DATA TYPES 


+ A TYPE CHARACTERIZES A SET OF VALUES WHICH 
OBJECTS OF THE TYPE CAN TAKE ON AND ASET 
OF VALID OPERATIONS ON THE OBJECTS 


+ TWO DIFFERENT TYPE DECLARATIONS ALWAYS 
DEFINE TWO DISTINCT TYPES 


* OBJECTS OF DISTINCT TYPES CANNOT BE OPERATED 
UPON TOGETHER WITHOUT EXPLICIT CONVERSION 
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Which of the following are valid 
assignment statements? 


1. CAR i= LJ 


2 spoT 

3. PHYDEAUX z=» 
4. SPOT := PHYDEAUX; 
5. PHYDEAUX := SPOT; 
6. CAR:2 TS 

7. SPOT: 


8 spots: 
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TYPE DECLARATIONS 


type RR_CARS is =~ WE SD wh 


ns aa 


type MIXED Is Ww Sw ee 


OBJECT DECLARATIONS 


CAR:RR_CARS:= Wh 
SPOT:MIXED :z SY 
PHYDEAUX : constant ANIMALS := Ww 


CAR SPOT PHYDEAUX 


[=] Cw 
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SUBTYPES 


A SUBTYPE IS A TYPE TOGETHER WITH A CONSTRAINT 
THE TYPE IS KNOWN AS A BASE TYPE 

THE CONSTRAINT CAN BE NULL (an alias) 

ATYPE |S A SUBTYPE OF ITSELF 


A VALUE BELONGS TO A SUBTYPE OF A GIVEN TYPE IF 
IT BELONGS TO THE TYPE AND SATISFIES THE CONSTRAINT 


THE SUBTYPE INHERITS ALL OPERATIONS FROM THE BASE TYPE 
A TYPE MARK IS A TYPE IDENTIFIER OR A SUBTYPE IDENTIFIER 
THE TYPE OF AN OBJECT IS KNOWN AT COMPILATION TIME Stak (c 


VIOLATION OF SUBTYPE IS ALWAYS A CONSTRAINTERROR y nar ¢ 
_NIOLATION OF SUBTYPE IS ALWAYS A CONSTRAINT ERROR _ 
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Which of the following are valld 
assignment statements? 


objects of a subtype are implicitly compatible with 
objects of the base type and with objects of other 
subtypes with the same base type 


4. MY_OBJECT := JE 


2. MY_OBJECT := SHARP; 


type THINGS Is Gstrsn Qe 3. MY_OBJECT := LETHAL; 


subtype WEAPONS Is THINGS FHA 4. LETHAL:= 9 
t r- 
. LETHAL := MY_OBJECT; 
eubtype POINTED_OBJECTS ie THINGS | # THRU s ae 


6. LETHAL := 7 


OBJECT DECLARATIONS 7. SHARP := LETHAL; 


8. RP = MY_OBJECT; 
LETHAL : WEAPONS := 3 SHARE ; 


MY_OBJECT : THINGS :« 3 
SHARP : POINTED_OBJECTS := 7 


v & 
< ver 
AGE WON “y Yer 
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INTEGER ATTRIBUTES 


An Integer type characterizes a set of whole 


number values and a sat of operations on IPs: SAMPLE tesrange:t =:20%:- 
whole numbers * SAMPLEFIRST =1 
* SAMPLELAST -- 20 
. Bra en (17) -16 
°. 'SUCC (20)... - CONSTRAINT_ERROR 
type DEPTH Is range -1000 ...0; [+ SAMPLE'MAGE (12) — "12" - 


type ROWS Is range 1 .. 8; 
type LINES Is range 0 .. 68; 


subtype TERMINAL Is LINES range 0 .. 24; 


Lt SAMBLEVALUE ("129__=-12.~ 
> SAMPLE'VALUE ("21") _ -~- CONSTRAINT_ERROR 


INTEGER OBJECT DECLARATIONS MY_INT : SAMPLE := SAMPLE'FIRST; 


ROW_COUNT : ROWS; * ‘Based Literals’ explicitly spacity 
LINE_COUNT :LINES = 1; the base from two to sixteen 
CAT : TERMINAL := 16; 
FATHOMS _—_: constant DEPTH = -100; + ‘Extended Digits’ are the letters 
‘A thu'F 
ROW_COUNT —_LINE_COUNT FATHOMS MY_HEX_VALUE : NATURAL := 1647A84; 


THIRTY_ONE ; constant INTEGER := 241_11118; 


ce Shdok 4 4. ooh 
a <p biy yeu i) o™ 
a ocr 


Ouve o~ 
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REAL TYPES 


Real types provide approximations to the real numbers. 


There Is always some error associated with a value of a real type. 


If the error grows as the magnitude of the number Increases then we 
are dealing with floating point types (relative precision). 


. 


then we are dealing with fixed point types (absolute precision). 


+ Areal type determines a set of model numbers which can be 
represented exactly. 


+ Ifan operation ylelds a model number, It dellvers that number. ff It 
ylelds a number between two model numbers, it delivers elther the 
lower or upper. 
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FLOATING POINT TYPES 


* INDICATES NUMBER OF SIGNIFICANT DIGITS 
{actually converted to significant bits) 


* THE TYPE IS GUARANTEED TO HAVE AT LEAST 
THIS MUCH PRECISION 


+ AN IMPLEMENTATION WILL REPORT IF IT IS 
UNABLE TO HANDLE THE REQUESTED PRECISION 


+ RANGE CONSTRAINT IS OPTIONAL 


type COEFFICIENT Is digits 10 range -1.0 .. 1.0; 
type REAL is digits 8; 

subtype SHORT_COEFF Is COEFFICIENT digits 5; 
subtype NARROW Is REAL range 0.0 .. 20.0; 


model numbers 


If the error remains constant as the magnitude of the number Increases 


FIXED POINT TYPES 


+ INDICATES ACTUAL DIFFERENCE BETWEEN MODEL NUMBERS 
¢ RANGE CONSTRAINT IS NOT OPTIONAL FOR TYPE 
* RANGE CONSTRAINT IS OPTIONAL FOR SUBTYPE 


type MONEY Is delta 0.01 range 0.0 .. 1_000_000.0; 
subtype PAY ls MONEY range 0.0... 1_000.0; 


subtype DOLLARS fs MONEY detta 1.0; 


model numbers 
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EE 
TYPE CONVERSION FUNCTIONS 


* OBJECTS OF DISTINCT TYPES CANNOT BE (IMPLICITLY) 
MIXED IN OPERATIONS 


* OBJECTS OF DISTINCT NUMERIC TYPES CAN BE (EXPLICITLY) 
MIXED IN OPERATIONS IF THE VALUE OF ONE TYPE IS 
CONVERTED TO THE OTHER TYPE 


* THE IDENTIFIER OF THE TYPE BECOMES THE IDENTIFIER OF 
AFUNCTION FOR PURPOSES OF CONVERSION (TRANSFER) 


type MY_INT Ie range 0 .. 100; 
type MY_FLT is digits 10 range 0.0 .. 100.0; 


INT_OBJECT : MY_INT; 
FLT_OBJECT : MY_FLT; 


INT_OBJECT := MY_INT (FLT_OBJECT); -- rounding 
FLT_OBJECT := MY_FLT (INT_OBJECT); 


type transfer 
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EXPONENTIATION 


x * Y 


if X is of any poe. a then Y must be of the 
predefined type | ER and must not be negative. 


if X is of any real type then Y must be of the 
predefined type INTEGER. 


The above two rules apply only for the exponentiation 
operation which is implicit with a type. The 
programmer is free to overload the operator to provide 
exponentiation by values other than INTEGER. 
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ENUMERATION TYPE ATTRIBUTES 


type SPEED Is (SLOW, MODERATE, FAST); 


SPEED'FIRST - SLOW 

SPEED'LAST ~- FAST 
SPEED'SUCC(SLOW) ~ MODERATE 
SPEEDPRED(SLOW) — CONSTRAINT_ERROR 
SPEED'POS(SLOW) -0 

SPEED'VAL(2) ~ FAST 


SPEED'IMAGE(FAST)  —"FAST* 

SPEED'VALUE("SLOW) ~ SLOW 

SPEED'VALUE(siow)  ~ SLOW 

SPEED'VALUE((QUIK) ~ CONSTRAINT_ERROR 

SPEEDWIDTH “BON I woh 


cublye 
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NUMBER DECLARATIONS 


+ ASPECIAL FORM OF CONSTANT DECLARATION 
+ THE EXPRESSION MUST BE STATIC AND EITHER 
unlversal_integer = or 
unlversal_real 
* INTEGER NAMED NUMBERS ARE IMPLICITLY COMPATIBLE 
WITH ANY INTEGER TYPE 


+ REAL NAMED NUMBERS ARE IMPLICITLY COMPATIBLE 
WITH ANY REAL (FIXED OR FLOAT) TYPE 


PI : constant := 3.14159_26536; 
TWO_PI : constant := 2.0 * Pl; 
MAX : constant := 500; 


POWER_16 1 constant := 2 ** 16; 
ONE, UN, EINS : constant := 1; 
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CHARACTER TYPE DECLARATIONS 


type CHARACTER Is (nul, SON, .......1.0'A’sssseesese'Bssssessssses ) — predefined 
type ROMAN_DIGIT Is (‘I 'V, 'X’, 'L, 'C’, ‘0’, 'M)); 
type VOWELS Is (‘A’, ‘E’, 'T, 0’, "U’); 


subtype FORTRAN_CONVENTION Is CHARACTER range ‘I’. . ‘N's 


CHARACTER OBJECT DECLARATIONS 


INDEX : FORTRAN_CONVENTION := 'K’; 
ROMAN_100: constant ROMAN_DIGIT := 'C'; 
MY_ CHAR : CHARACTER; 


INDEX ROMAN_100 MY_CHAR 
a 


NOTE: In Ada, character types are considered to be 
enumerated types. This Is not the case In Pascal, 


Sof 
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TYPE BOOLEAN 


type BOOLEAN is (FALSE, TRUE); -- predefined 


P, Q, R : BOOLEAN; 


-- All relatlonal operators apply (=, /=, <, <=, >, >=) 
-- The following logical operators are in the language: 
NOT, AND, OR, XOR 


P orQaR 
P and QandR 


— a legal boolean expression 
~ also legal 


Por QandR ~~~ Illegal, needs parentheses > 


Soft 


P or (Qand R) 
(Por Q) andR 


— legal 
— legal 
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MEMBERSHIP OPERATION 


Used to determine If an expression Is in a given subtype 


109 


Expression must be of the same basetype as the subtype 
Result of IN is true if the expression is In the subtype 
NOT IN Is an infix operation 

Membership operations cannot be overloaded 

subtype ALPHA Is CHARACTER range ‘A’ .. 'Z; 
CH : CHARACTER; 

NUM : INTEGER; 


TEXT_10.GET(CH); 
Ht CH Tn ALPHA then... 


it NUM In 7..15 then... 


The following are equivalent: 


.-. CH not In ALPHA... 
» . mot (CH In ALPHA)... 


Sow sallhye® 


j 
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+ Highest Precedence * NOT ABS 
+ Multiplicative * 7 MOD REM .—- Taubes bee 
+ Unary Additive + - au 
* Binary Additive + - & 
{ ¢ Relational = @) < > & > 
* Membership @® NOTIN 
{ + Logical AND OR  XOAR 
+ Short-Cireult (oxo THEN OR ELSE > 
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SHORT-CIRCUIT OPERATORS 


not A AandB 


Both subexpression for AND, OR and XOR will always be 
evaluated. 


AND THEN and OR ELSE are operations which will evaluate the 
right hand side of a booloan expression only If the left hand 
_ Side has not already detormined the result of the expression 
pias Serna : 


ItX/m0O andthen YX>=17 then... am 


! 


HPTA=null orese PTR.LEFT> 10 then... | 


Fea Ree eee eeeeae | 
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CONSTRAINED ARRAYS 


type TABLE is array (INTEGER range 1 .. 5) of FLOAT; 
MY_LIST : TABLE := (3.7, 14.2, -6.5, 0.0, 1.0); 


type DAYS is (SUN, MON, TUE, WED, THU, FRI, SAT); 
type WEEK_ARRAY is array (DAYS) of BOOLEAN; 


T : constant BOOLEAN := TRUE; 
F : constant BOOLEAN := FALSE; 
MY_WEEK : WEEK_ARRAY := (MON .. FRI => T, others => F); 


MY_LIST MY_WEEK 


an 


- 


ono ff © ND 
= 
25 55 


MY_LIST (4) := 7.3; 
if MY_WEEK (THU) = true then... 
if MY_WEEK (THU) then... 
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ARRAYS OF ARRAYS 


type DAY_SCHEDULE is array (CLASS_PERIOD) of CLASSES; 
type WEEK_SCHEDULE is array (WEEKDAYS) of DAY_SCHEDULE; 
MY_DAYS : WEEK_SCHEDULE; 


MON TUE WED THU FRI 


-_ 
= 
= 


uo a a ON 


if MY_DAYS (WED)(3) = ENGLISH then... 
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MULTEDIMENSIONED ARRAYS 


subtype WEEKDAYS is DAYS range MON... FRI; 


type CLASS_PERIOD is range 1.. 7% 
type CLASSES Is (HISTORY, ENGLISH, COMP_SCI, CALCULUS, FREE); 


type SCHEDULE is array (WEEKDAYS,CLASS_PERIOD) of CLASSES; 
MY_SCHEDULE : SCHEDULE; 


FRI 
COMP_scl | COMP_SCI 


CALCULUS 


if MY_SCHEDULE (WED, 3) = ENGLISH then... 
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SLICES OF ONE-DIMENSIONAL ARRAYS 


* Aslice is a ‘subarray’ 


+ Slices have the same index type and component type 
as thelr parents 


+ Asdice is created as an indivisible action, not 
component by component 


type SLICE_EXAMPLE le array (1..7) of INTEGER; 
MY_SLICE : SLICE_EXAMPLE := (1,2,3,4,5,6,7); 


1 2 3 4 5 6 7 
MY_SLIGE (2 .. 4) := (8, 8, 8); 

1 2 3.°«4 5 6 7 

Se ee | 


MY_SLICE (1 .. 4) := MY_SLICE (3 .. 6); 


1 2 3 4 #§ 6 7 


i 
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UNCONSTRAINED ARRAYS 


* INDEX TYPE AND COMPONENT TYPE BOUND TO ARRAY TYPE 


+ INDEX RANGE BOUND TO OBJECTS, NOT TYPE 


+ ALLOWS FOR GENERAL PURPOSE SUBPROGRAMS 


INCLUDES Ada STRING TYPE 


type SAMP Is array (INTEGER range <>) of FLOAT; 


LARGE : SAMP (1 .. 5) := (2.5, 3.4, 1.0, 0.0, 4.4); 
SMALL : SAMP (2.4) :=(2..4 => 5.0); 


LARGE SMALL 


a bon = 
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Ada STRINGS 


type STRING Is array (POSITIVE range <>) of CHARACTER; — predefined 


STR_5: STRING (1 ...5); 
STR_6: STRING (1..6):="Framus"; 
WARNING : constant STRING := "DANGER’; *\ 


subtype TEN_LONG Is STRING (1 .. 10); 


FIRST_TEN : TEN_LONG ‘= "HEADER"; 


STR_6 WARNING 


23 45 6 23 45 6 


FIRST_TEN 


123 45 6 7 8 9 
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USING UNCONSTRAINED ARRAYS 


function SUM (S : SAMP) return FLOAT Is 
TOTAL : FLOAT : t= 0.0; 
begin 


1% INDEX In S'FIRST .. S'LAST 
loop 

TOTAL := TOTAL + S (INDEX); 
end loop; 


return TOTAL; 


end SUM; 


FUNCTION CALLS 


put (SUM (SMALL); —15.0 
IfSUM (LARGE) >17.0 then... -—11.3 


(LARGE) 
(SMALL) 
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CATENATION 


+ APPLIES TO ONE-DIMENSIONAL ARRAYS 
+ FOUR FORMS 


LEFT mot RESIAT 
Strat UW) 
Y TYPE ARBA Y TYPE aneigy TY 
Saves): Chencla vce 
ARRAY TYPE COMPONENT TYPE | ARRAY TPE 


ARRAY TYPE 


COMPONENT TYPE | ARRAY TYPE 
COMPONENT TYPE | COMPONENT TYPE | ARRAY TYPE 


STR: STRING( | 4,/ ): AS aaa ; & oe 


Enter an appropriate range constraint 


o 
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LOGICAL OPERATIONS ON BOOLEAN ARRAYS 


* The logical operations of NOT, AND, OR and XOR are 
as appropriate for one-dimensional arrays whose 
component type is "boolean’ as they are for scalar 
objects of type ‘boolean’ 
type BOOLS is array (1..4) of BOOLEAN; 


T : constant BOOLEAN := TRUE; 
F : constant BOOLEAN := FALSE; 


P : BOOLS :=(T, T, F, Fi; 
Q : BOOLS := (T, F, T, F); 
PandQ PorQ 
Ce 
ia 
a 


4 


4 


4 
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THE RANGE ATTRIBUTE 


« APPLIES TO ALL ARRAY OBJECTS 

* APPLIES TO ALL CONSTRAINED ARRAY TYPES 
* DOES NOT APPLY TO ENUMERATION TYPES 

« P'RANGE EQUATES TO P’FIRST .. PLAST 


type RANGE_EXAMPLE Is array(1..4) of FLOAT; 
SAMPLE : RANGE_EXAMPLE; 
STR : STRING (1..10); 


* THE FOLLOWING ARE VALID USES OF RANGE 


RANGE_EXAMPLE’RANGE 1.4 
SAMPLE'RANGE ~1..4 
STR'RANGE -1..10 


121 


Software Engineering with Ade 


ANONYMOUS ARRAY OBJECTS 


A: array (1 .. 10) of BOOLEAN; 
B : array (1... 10) of BOOLEAN; 


* ANONYMOUS OBJECTS HAVE NO TYPE MARK 
* CANNOT APPEAR AS RECORD COMPONENTS 
* CANNOT BE PASSED AS PARAMETERS 

+ THE TWO ARRAYS ARE NOT COMPATIBLE 


A, B : array (1 .. 10) of BOOLEAN; 


* ARE THE TWO ARRAYS COMPATIBLE? 
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NULL ARRAYS 


+ AN ARRAY WHICH CONTAINS NO COMPONENTS 


* THE LOWER BOUND OF THE INDEX IS GREATER THAN 


THE UPPER BOUND 
* ALLOWS THE ‘EMPTY’ STRING 


NULL_STRING : STRING(2 .. 1) := ""; 


for INDEX In NULL_STRING'RANGE 
loop = Ignores the loop 


end ‘loop; 


120 


122 
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RECORD TYPE DECLARATION 


type DATE_TYPE Is 
record 
DAY : INTEGER range 1 .. 31; 
MONTH : MONTH_TYPE; 
YEAR : INTEGER range 1700... 2150; 
end record; 


RECORD OBJECT DECLARATION 


TODAY : DATE_TYPE; 


TODAY 
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NESTED RECORDS 


+ COMPONENTS OF RECORDS MAY BE OF ANY TYPE, 
INCLUDING OTHER RECORDS 


* THE VALUE OF A NESTED RECORD IS A NESTED AGGREGATE 


* COMPONENT SELECTION USES EXTENDED ‘DOTTED’ 
NOTATION 


type TEMPERATURE_LOG is 
record 


TEMP : INTEGER; 
DATE :DATE_TYPE; 
end record; 


LOG : TEMPERATURE_LOG; 


LOG.TEMP := 50; 
LOG.DATE.DAY := 19; 
LOG.DATE.MONTH := JUN; 
LOG.DATE.YEAR := 1963; 


Loa 
[temp | 
joare | 
-- or [oay | 
LOG.DATE := (19, JUN, 1963); COL 
- or 

nae 
LOG := (TEMP => 50, 

DATE => (19, JUN, 1963); 

- or 
LOG := (50, (19, JUN, 1963); 
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DEFAULT RECORD COMPONENT VALUES 


+ Ifa component of a record type has a default value, every object 
declared to be of the record type will have that Initial value, 


type DEFAULT_EXAMPLE is 
record 


TOTAL : FLOAT := 0.0; 

STATE : STATE_CODE; 

VET  : BOOLEAN := TRUE; 
end record; 


SAMPLE : DEFAULT_EXAMPLE; 
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DISCRIMINATED RECORDS 


« Adiscriminant is a special component of a record 
* Discriminants must be of a discrete type 


* Other components may depend on discriminants 


subtype COUNTERS Ie INTEGER range 1 .. 100; 
type MY_LIST (SIZE : COUNTERS) is 
record 


TABLE : STRING (1 .. SIZE); 
end record; 


SMALL_LIST : MY_LIST (SIZE => 2) := (2, ("HI"); 
BIGGER_LIST : MY_LIST (4) := (4, ("HELP"); 


DISCRIMINANT CONSTRAINT 


SMALL_LIST 


BIGGER_LIST 


Ase CO Migs as 
Obs ot Lal i ld ia 


a —\ a _ ee. 
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UNCONSTRAINED DISCRIMINATED RECORDS 


If the discriminant has a default value and the object Is declared 
using the default discriminant, then the discriminant can vary 
during execution. 


type MSG_TYPE (SIZE : COUNTERS := 1) Is 
record 
CONTENT : STRING (1 .. SIZE); 
end record; 


| MESSAGE : MSG_TYPE; \ 


MESSAGE := (3,"Ada"); 
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ACCESS TYPES 
+ DESIGNATED OBJECTSIARE DYNAMICALLY ALLOCATED 
(PERHAPS IN AN AREA OF A HEAP) 


. VALUES!IPROVIDE A WAY TO REFERENCE 
DESIG! OBJECTS 


+ ACCESS CONTAIN ACCESS VALUES AND 


ARE STATICALLY ALLOCATED (IN THE USER AREA) 
OR APPEAR IN DESIGNATED OBJECTS (AS LINKS) 


type SAMPLE is 
record 
AGE : NATURAL; 
GPA : FLOAT; 
end record; 


ACCESS TYPE 


type PTR Is access SAMPLE; 


ACCESS OBJECTS 


JOHN, MARY : PTR; 
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RECORD VARIANT PARTS 


array but, the 
* Notonly can length be determined by a discriminant, but, 
pastel velbcks of certain flelds can depend on a discriminant 


type DEVICE is (PRINTER, DISK, DRUM); 
type STATE Is (OPEN, CLOSED); 


type PERIPHERAL (UNIT : DEVICE := DISK) Is 
record 


STATUS : STATE; 
case UNIT Is 
when PRINTER => 
LN_COUNT : NATURAL; 


when others => 
CYLINDER : NATURAL; 
TRACK : NATURAL; 
end case; 
end record; 
WRITER: PERIPHERAL (UNIT => PRINTER); 
ARCHIVE : PERIPHERAL; 
WAITER ARCHIVE 
PUNT 
PRINTER 
STATUS [eras] 
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JOHN MARY 


USER'S AREA (STATIC) 


THE 
HEAP 


Space reserved 
for designated 


objects (PTR) { 


ALLOCATORS 
MARY := new SAMPLE((AGE => 16, GPA => 2.5); 
JOHN := new SAMPLE (17, 3.4); 


ae 


Slovags -QvMOr = He 
Orcas 


NUMmoavil — Cre 
Contin evey 
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DEREFERENCING 


JOHN.AGE := MARY.AGE; -- component assignment 
JOHN 


JOHN.all := MARY.all; — entire object assignment 
JOHN 


[== 
MARY 


JOHN := MARY; -- access value assignment 
JOHN 
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PRIVATE TYPES 


+ ACTUAL TYPE DESCRIPTION IS ‘HIDDEN’ 
+ THE TYPE IS PRIMARILY KNOWN THRU ITS OPERATIONS 


* PRIVATE TYPES ARE ALWAYS IMPLEMENTED 
BY PACKAGES 


« PRIVATE TYPES PROTECT DATA FROM ERRONEOUS 
ACCESS 


+ IF AN OBJECT IS OF APRIVATE TYPE, ASSIGNMENT, 
(IN)JEQUALITY AND ALL EXPLICITLY DECLARED 
OPERATIONS ARE ALLOWED 


+ IF AN OBJECT IS OF ALIMITED PRIVATE TYPE , 
ONLY THE EXPLICITLY DECLARED OPERATIONS 
ARE ALLOWED 
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ACCESS TYPES 


(Memory Allocation) 
type NODE; - Incomplete type deci. 


users |-1 1 | 
type PTA is access NODE; 
USER 2 
type NODE Is 
record 


FIELD_1 : SOME_TYPE; | HEAP 
FIELD_2 : BLAH; 

FIELD_3 : FOO; 

FIELD_4 : FRAMUS; 

FIELD_S : PTR; 


end record; 


TOP: PTR; ~ an access object 


TOP := new NODE; ~ an allocator 


TOP.FIELD_5 := new NODE; -~ another allocator 
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DERIVED TYPES 


+ INHERITS ALL VALUES (WITH AN OPTIONAL 
CONSTRAINT) AND ALL OPERATIONS (INCLUDING 
USER-DEFINED) FROM A PARENT TYPE 


* THE DERIVED TYPE AND THE PARENT TYPE ARE 
NOT IMPLICITLY COMPATIBLE 


« TYPE TRANSFER BETWEEN PARENT AND DERIVED 
TYPE |S PERMITTED 


* TYPE TRANSFER BETWEEN OBJECTS OF TWO 


DIFFERENT TYPES DERIVED FROM THE SAME PARENT 
IS PERMITTED 


type MY_STRING_TYPE Is new STRING; 
MY_STRING : MY_STRING_TYPE (1 .. 10); 
STR : STRING (1 .. 10); 

MY_STRING := MY_STRING_TYPE (STR); 


t 


TYPE TRANSFER 
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SUBPROGRAM DECLARATIONS 


procedure GENERATE_HEADING; 


procedure PUSH( E_— : in ELEMENT; 
ON : in out STACK); 


procedure INCREMENT (COUNT : in out COUNTER); 
function SQRT (ARG : FLOAT) retum FLOAT; 
function GET_NEXT retum CHARACTER; 

function "+" (S1, S2 : SET) return SET; 

function INVERT (S : STRING) return STRING; 


* DEFAULT PARAMETERS (IN) 


function FIND ( Eee STRING : STRING; 
GET : STRING: 
START ‘INTEGER := 1 
retum INTEGER; 
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OVERLOADING 


* THE DESIGNATORS ANAL a OR SYMBOL) OF 
SUBPROGRAMS NEED NOT BE UNIQUE 


AMBIGUITY CAN BE RESOLVED BY COMPARING 
PARAMETER AND RESULT TYPE PROFILES 
OR BY QUALIFICATION 


« TYPE PROFILES 
-- NUMBER OF PARAMETERS 
-- TYPES OF PARAMETERS rad POSITION) 
-- TYPE OF RESULT (FUNCTIONS ONLY) 


AMBIGUITIES WILL BE REPORTED BY THE 
COMPILER 
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SUBPROGRAM CALLS 


GENERATE_HEADING; 

PUSH (NEW_ELEMENT, ON => MY_STACK); 
INCREMENT (TALLY); 

STD_DEV := SQRT (VARIANCE); 

LETTER := GET_NEXT; 

SET_OF_PETS := SET_OF_CATS + SET_OF_DOGS; 
PALINDROME := INVERT(S) = S; 

MY_INDEX := FIND ("Hello", MESSAGE, START => 5); 
MY_INDEX := FIND ("Hello", MESSAGE); 
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OVERLOAD RESOLUTION 


type COLOR is (RED, GREEN, BLUE, ORANGE 
type LIGHT is (heD YELLOW, GREEN); 


procedure SET UE : COLOR); 
procedure SET (HUE : LIGHT) 

procedure SET (SPOT : INTEGER} 
procedure SET (FLAG : BOOLEAN); 


SET (BLUE); 
SET (1 


SET (RED); ~ ambi 
SET (LIGHT(RED)); Bre 


QUALIFICATION 


| es 
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SUBPROGRAM BODIES] 1. 5f), ) oe 


» Af [J] 
<subprogram_body> fs) - Ce Oe 


\ 
<subprogram_specification> is) £7 Nor-+4 Qrmo 
4 reservel wo. a TO BE 'LOCAL' TO THAT BLOCK 


(<declarative_part>]. a 
begin 
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BLOCK STRUCTURE 


SUBPROGRAMS CAN BE NESTED 


AN OBJECT DECLARED IN A BLOCK AND 
REFERENCED IN THE SAME BLOCK IS SAID 


AN OBJECT DECLARED IN A BLOCK AND 
REFERENCED IN AN INNER BLOCK IS SAID 


re ge ( Of pnd ) TO BE 'GLOBAL’ TO THAT INNER BLOCK 
. AN OBJECT DECLARED IN AN INNER BLOCK 
[exception IS INACCESSIBLE FROM AN OUTER BLOCK 
<exception_handler> AN OBJECT DECLARED IN AN INNER BLOCK 
? \ CAN BE A HOMOGRAPH OF AN OBJECT 
{<exception_handler>}] - Dor be) DECLARED IN AN OUTER BLOCK AND WILL 
' ‘HIDE' THE OBJECT IN THE OUTER BLOCK 
end [<designator>]; . } or 
wee - 
a. @ deus, 
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A MODEL OF SUBPROGRAM ACTIVATION 


DYNAMIC VIEW 


Ais called 
Acalls B 
Bcalls C 
Ccalls D 
D calls C 
C returns 
D returns 
C returns 
B returns 
A returns 


Consider the implementation of a subprogram to be in 
two parts: a unique code segment and an activation 
record 


activation record 


local variables 


static link mere | 


code segment 


reentrant code, no 
data maintained 


ooo 


code segments run-time stack 


A 
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ASSIGNMENT STATEMENTS 
© 


+ The variable takes on the value of 
the expression 


* The variable and the expression must 
be of the same type 


MY_LINT 17; — Integer 
LIST(2..4) = LIST (7..9); - slice 
TODAY == (13, DEC, 1964); — aggregate 
x = SORT (¥); — function call 
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PROCEDURE CALL 


¢ Aprocedure call is a sequential statement in 
an ‘extended’ language 


¢ Awell-named procedure exemplifies both 
abstraction and information hiding 
DISPLAY (TODAYS_DATE); 
RAISE_ALARM; 
TEXT_IO.PUT_LINE (THE_MESSAGE); 
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* Used when no action is to take place 


Explicit 'null' avoids problem which 
arise in some languages by using the 
‘empty’ statement 


case FRAMUS Is 
when 1 => <seq-of-stmts> 


when 2 => <seq-of-stmts> 
when others => null; 
end case; 
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RETURN STATEMENT 


+ RETURN STATEMENTS ONLY OCCUR IN SUBPROGRAMS 


* WHEN A RETURN STATEMENT IS EXECUTED, CONTROL 
IS IMMEDIATELY PASSED TO THE POINT OF CALL 


"RETURNS' FROM FUNCTIONS MUST BE ASSOCIATED 
WITH AN EXPRESSION ve 


‘RETURNS’ FROM PROCEDURES ARE ALTERNATIVES TO 
‘FALLING THROUGH THE BOTTOM' OF THE PROCEDURE 


procedure DO_IT is 
begin 


if... then / 
<stmt> VA 
<stmt> ys 
return; 

end if; 
<stmt> 


<stmt> 
end DO_IT; 


| yp ¢ 4 
Oe E (( T Ar oug! pra, 


Prog? am _~@vrorv- 


v 
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RETURN FROM FUNCTION 


* Falling through the bottom of a function 
results ina PROGRAM_ERROR exception 


function SQRT (ARG : FLOAT) retum FLOAT Is 
RESULT : FLOAT; 


begin 
-- statements to calculate RESULT 


return RESULT; 


exception 
-- either a RAISE or RETURN statement must appear here 


end SQRT; 
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BLOCK STATEMENTS 


EXAMPLE: = 
leciare The name- 
|EXAMPLE.Iis > 
|: INTEGER; “Javailable within the 
procedure SUB is... procedure SUB. 
begin 
INT_IO.GET (1); 
SUB; 
exception 
when NUMERIC_ERROR | CONSTRAINT_ERROR => 
DO_SOMETHING; 


end EXAMPLE; 
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BLOCK STATEMENTS 


« A block statement provides localization for 


-- declarations 
-- exceptions 
-- or both 


declare 
TEMP : INTEGER := X; 
begin ‘ 


9g 
GET (MY_VALUE); 
exception 


when CONSTRAINT_ERROR => 
- action for dealing with error 


end; 
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BLOCK STATEMENTS 


<block_statement> ::= 
[<block_simple_name>:] 
[deciare 
<deciarative_part>] 
begin 
<sequence_of_statements> 
[exception 


<exception_handler> 
{<exception_handler>}] 


end [<block_simple_name>); 


After exceptions are handled, control passes to the next 


sequential Instruction 
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CONDITIONAL STATEMENTS (IF) 


if TODAY.DAY = 30 and TODAY.MONTH = JUL then 
PEGS_YEARS := PEGS_YEARS + 1; 
GET (BIRTHDAY_CARD); 

end if; 


if IS_ODD (NUMBER) then 
ODD_TOTAL := ODD_TOTAL + 1; 


else 
EVEN_TOTAL := EVEN_TOTAL +1; 
end if; 


if SCORE >= 90 THEN GRADE :=‘A'; 
elsif SCORE >=80 THEN GRADE :='B'; 
elsif SCORE >=70 THEN GRADE := 'C'; 
elsif SCORE >=60 THEN GRADE :='D'; 


alse GRADE := 'E'; 
end if; 
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CONDITIONAL STATEMENTS (CASE) 
procedure SWITCH (HEADING : In out DIRECTION) is 
begin 

case HEADING is 
when NORTH => HEADING := SOUTH; 
whenEAST => HEADING := WEST; 
when SOUTH => HEADING := NORTH; 
when WEST ==> HEADING := EAST; 

end case; 


end SWITCH; 


case NUMBER is 


when 2 => <sequence_of_statements> 
when 3|7|8 => <sequence_of_statements> 
when9..20 => <sequence_of_statements> 
when others => <sequence_of_statements> 


end case; 
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CONDITIONAL STATEMENTS (IF) 


<if_statement> ::= 


If <condition> then 
<sequence_of_statements> 
{elsif <condition> then 
«<sequence_of_statements>} 
[else 
«<sequence_of_statements>] 
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CONDITIONAL STATEMENTS (CASE) 


<case statement> ::= 


case <discrete_expression> is 
when <choice> {|<choice>} => 
<sequence_of_statements> 
{when <choice> {|<choice>} => 
<sequence_of_statements> } 
end case; 


<choice> ::= 


<discrete_expression>| 
<discrete_range>| 
others 


NOTE: THE CHOICES MUST BE MUTUALLY EXCLUSIVE 
COLLECTIVELY Conca MORE THAN ONCE) AND ALSO 
STIVE (EVE 

TREATED) ( RY VALUE IS 
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ITERATION STATEMENTS 


loo; 
GET (S Ss AMPLES); 
PROCESS (SAMPLES); 
end loop; 


fae 
ET (NUMBER); 
exit when NUMBE 
PROCESS (NUMBER), 
end loop; 


while DATA_REMAINS 

loop 
<sequence_of_statements> 

end loop; 


OUTER: 
loop 
<sequence_of_statements> 


POP 
liuence_of_statements> 
oa UTER when NUMBER > 7; 
end loop; 


<sequence_« of [_statements> 
end loop OUTER 
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AN ADA IDIOM FOR INPUT 


Input of numeric data can generate exceptions: 
INT_10.GET(MY_NUMBER); 


This statement could, when expecting data from the 
keyboard, raceive characters which do not conform to 
the syntax of the base type of MY_NUMBER. An 
exception handler Is, therefore, appropriate. 


INT_IO.GET(MY_NUMBER); 
exception 


when TEXT_IO.DATA_ERROR => 


But, exception handlers can occur only in block statements 
or in bodies of subprograms, packages and tasks. We 
shall use a block statement to achieve our purpose. 


begin -- block statement 
INT_IO.GET(MY_NUMBER); 
exception 


when TEXT_IO.DATA_ERROR => 
<sequence_of_statements> 


end;  -- block statement 
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CONTROL VARIABLES 


¢ ARE IMPLICITLY DECLARED 
* MUST BE DISCRETE 


* TAKE THEIR TYPE FROM THE DISCRETE RANGE 


¢ ARE IN EXISTENCE ONLY UNTIL end loop 
* CAN 'HIDE' A VARIABLE WITH SAME NAME 
* CANNOT BE MODIFIED (LOCAL CONSTANT) 


« ONLY SINGLE STEP INCREMENT (DECREMENT) 


for INDEXin DAYS -- SUN... SAT 
loop 


end loop; 


for COUNTER in reverse 1 .. 10 
loop 


end loop; 


AN ADA IDIOM FOR INPUT 


But, we probably want the user to be able to repeat 
the action until no error occurs. Therefore, we encase 
the block statement inside of a loop statement 


loop 
begin 
INT_IO.GET(MY_NUMBER); 
exception 
when TEXT_IO.DATA_ERROR =>... 
end; 


end loop; 


But, this allows us no way to leave the loop. Therefore, 
we complete the idiom by inserting an exit statement 
which will be executed only if the INT_IO.GET statement 
does not raise an exception. 


loop 
begin 
NT 10.GET(MY_NUMBER); 
exit; 
exception 
when TEXT_IO.DATA_ERROR => 
<sequence_of_statements> 
end; 
end loop; 
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Write a program which will take the frequency 
count of the letters In a string (message). The 


user of the program should be able to Indicate 
how many elements of the freq count are to 
be printed per line. 


TEXT: "AMWAY FOLKS WRITE COBOL IN ADA" 
COLUMNS :4 
OUTPUT: 


A=4 Bz=1 C=1 De! 


U= V=0 We=2 X=0 
Net 22000 

a xX 
/ (AV OL —- po 4 
Se ae io 

a ae sy | 

JA eS Sedge fs cs 
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separate (MAIN) 
function FREQ (MSG : string) return FREQ_TABLE is 


TABLE : FREQ_TABLE := (‘A’.. 'Z' => 0); 
begin 

for INDEX in MSG'range 

loop 


if MSG(INDEX) in ALPHA then 


TABLE (MSG (INDEX)) := 
TABLE (MSG (INDEX)) + 1; 


-- TABLE (‘A) := TABLE (‘A’) +1; atc. 
end if; 
end loop; 
return TABLE; 
end FREQ; 


TABLE 


DROOUIBE | o) 


A B C 0D E F G 
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with TEXT_IO; 
procedure MAIN is 


subtype ALPHA is CHARACTER range ‘A’ .. 
ye FREQ TABLE is array (ALPHA) of NATURAL; 


COLUMNS : NATURAL; 
package INT_!O is new ‘TEXT_IO.INTEGER_IO (INTEGER); 


function FREQ (MSG : STRING . 
return FREQ_TABLE is separate; 


cedure PRINT (TABLE : FREQ_TABLE; 
scaaiinia UNIT S PER_LINE: NATURAL) is separate; 


begin 


TEXT_IO.PUT_LINE ("How many columns of ane "& 
“per line? (enter 1 to 10)" 


INT_IO.GET (COLUMNS); 


PRINT (TABLE => FREQ eee FOLKS WRITE" & 
COBOL IN ADA’), 
UNITS_PER_LINE => COLUMNS); 


end MAIN; 
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separate (MAIN) 
procedure PRINT (TABLE REQ_TABLE; 


UNITS_PER_| LINE: NATURAL) is 
CH: ALPHA := ALPHATFIRST; -- ‘A’ 
begin 


OUTER: -- anamed loop 
loop 


for lin 1 .. UNITS_PER_LINE 
loop 


INT 0. PUT hcidowy 
TEXT_IO.PUT (” 


exit OUTER when CH = ALPHA' 
CH := ALPHA'SUCC (CH); oe 


end loop; -- for | 
TEXT_IO.NEW_LINE; 


end loop OUTER; 
TEXT_IO.NEW_LINE; 
end PRINT; 


-- only when 'Z 
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GENERATE TOMORROW'S DATE 


The user enters today's date and the date is 
displayed. The date is transformed into 
tomorrow's date and the new date is displayed. 
Invalid dates raise exceptions. 


The primary objects of Interest are DATES. 
Operations on DATES are: ENTER, 

DISPLAY, and TRANSFORM. A bad date 
(such as 30 FEB) should ralse an exception. 
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The Ada package specification 
package DATE_PACKAGE Is yo f= 
if ne 


‘\) | type DATES is private; ie 
V| Ks procedure ENTER D : out DATES); 
rocadure DISPLAY D : in DATES); 


nction TRANSFORM (D : DATES) return DATES; 
BAD_DATE : exception; 


' 
Komen. 


private 


end DATE_PACKAGE; 


DATE_PACKAGE 
DATES ~Aé6 fe Cg le 
Cares) | 
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Pace II a AD PED ES 


with DATE_PACKAGE, TEXT_IO; 
procedure CHANGE_DATE Is 
TODAY, TOMORROW : DATE_PACKAGE.DATES; 
begin 
DATE_PACKAGE.ENTER (TODAY); 
TEXT_IO.PUT (‘Today Is. . ."); 
DATE_PACKAGE.DISPLAY (TODAY); 
TOMORROW := DATE_PACKAGE. TRANSFORM (TODAY); 
TEXT_}O.PUT ( and tomorrow is... ."); 
DATE_PACKAGE. DISPLAY (TOMORROW); 
exception 


when DATE_PACKAGE.BAD_DATE => 
TEXT_IO.PUT_LINE (“invalid date, restart process.”); 


end CHANGE_DATE; 
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The complete Ada package specification 


package DATE_PACKAGE is 


type DATES is private; 
procedure ENTER D : out DATES); 
rocedure DISPLAY D : In DATES); 


nction TRANSFORM (D : DATES) retum DATES; 
BAD_DATE : exception; 


private 


type MONTH_TYPE is ( JAN, FEB, MAR, APR, MAY, JUN, 
JUL, AUG, SEP, OCT, NOV, DEC); 


type DATES Is 
record 
DAY : NATURAL range 1 .. 31; 
MONTH : MONTH_TYPE; 


YEAR: NATURAL range 1800 .. 2150; 
end record; 


end DATE_PACKAGE; 
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with TEXT_1O; 
package body DATE_PACKAGE Is 


package MONTH_1O Is new TEXT_IO.ENUMERATION_IO (MONTH_TYPE); 
package INT_IO is new TEXT_IO.INTEGER_O (NATURAL); 


— bodies of all subprograms go here 
end DATE_PACKAGE; 


procedure DISPLAY (D : In DATES) Is 
bagin 
MONTH_IO.PUT(D.MONTH); 
INT_1O.PUT (D.DAY, 3); 
TEXT_}O.PUT (,); 
INT_}O.PUT (D.YEAR, 5); 
end DISPLAY; 


a 


bet =< dedi woetel- 
Prop 26% - rey tue = 
~ stub - sept 
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function DAYS_IN_MONTH (D : DATES) retum NATURAL Is 
begin 
case D.MONTH is 
when SEP | APR | JUN | NOV => retum 30; 
when FEB => 
it ((D. YEAR mod 4 = 0) and (D. YEAR mod 100 = 0)) 
or 
(D.YEAR mod 400 = 0) then 
Tetum 29; 
ese 
retum 28; D 
end ff DAY 
when others => retum 31; 
end case; 


end DAYS_IN_MONTH; 
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DAY 


procedure ENTER (D : out DATES) is 
type DATE_PROMPTS Is (OD, MM, YY); 
begin 


for SELECTOR In DATE_PROMPTS 
loop — outer loop for stepped Iteration 


— Inner loop to contain block 
a —local block to contain exception handler 
case SELECTOR ls 
when DD => TEXT_}O.PUT_LINE (‘day:7}; 
INT_IO.GET (D.DAY); 
when MMzo TEXT_IO.PUT_LINE (‘month:"); 
MONTH_IO.GET (D.MONTH); 
when YY => TEXT_IO.PUT_LINE (‘year’); 
INT_IO.GET (D.YEAR); 
endcase; : 
J ext; — leave the inner-most loop | 
exception 
when TEXT_IO.DATA_ERROR | CONSTRAINT_ERROR => 
case SELECTOR is 
when DD => 
TEXT_IO.PUT_LINE (‘enter integer 1 to 31°); 
when MM => 
TEXT_IO.PUT_LINE (“enter 34 month”); 
when YY => 
TEXT_IOPUT_LINE ("enter 4-digit year”); 
‘end case; 
end; — local block 
end loop; — Inner loop containing block 


end loop; —outer loop controlling Iteration 
end ENTER; 
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function TRANSFORM (D : DATES) return DATES Is 
LAST_DAY : constant NATURAL := DAYS_IN_MONTH (D); 
begin 
If D.DAY > LAST_DAY then 
raise BAD_DATE; 
end If; 


tf D.DAY /= LAST_DAY then 
Tetum (D.DAY + 1, D.MONTH, D.YEAR); 


1 D.MONTH /= MONTH_TYPE'LAST then 


eum (1, MONTH_TYPE'SUCG (0.MONTH), D.YEAR); 
end If; 


retum (1, MONTH_TYPE'FIRST, D.YEAR + 1); 
end TRANSFORM; 
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It was clear that a most powerful addition to any Package Specification -- the contract 


programming language would be the ability to define new 
higher level entities in terms of previously known ones, 


and then to call them by name. This would build the <package specification> ::= 

chunking right into the language. Instead of there being package <identifier> is 

a determinate repertoire of instructions out of which all {<basic_declarative_item>} 
programs had to be explicitly assembled, the ' 

programmer could construct his own modules, each with [private 

Its own name, each usable anywhere Inside the program, {<basic_deciarative_item>}] 


just as if It had been a built-in feature of the language. 


-- Douglas Hofstadter 
“Goedel, Escher, Bach” 


end [<package_simple_name>]; 


SPECIFICATION (visible) 
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PACKAGE VISIBILITY TEXTUALLY NESTED PACKAGES 


+ APACKAGE CAN BE MADE AVAILABLE IN TWO 
DISTINCT WAYS Procesture MAIN ath 


‘package COMPLEX Is Pe 
-- It can be textually nested (rarely used) type NUMBER... 


-- Itcan be accessed from a library ncion es 


package COMPLEX is 


— sequence of statements for MAIN 
type NESE is end MAIN; 
Teco! 


REAL_PART : FLOAT; 
IMAGINARY_PART : FLOAT; 
end record; 


function "+" (X,Y : NUMBER) return NUMBER; 
function "-" he y: NUMBER) return NUMBER: PACKAGES AS LIBRARY UNITS 
function “*" (X,Y : NUMBER) return NUMBER: 
‘ with COMPLEX: 
end COMPLEX; procedure MAINIs... 


MAIN 
COMPLEX 


176 
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PACKAGE SPECIFICATIONS PACKAGE BODIES - THE IMPLEMENTATION 
* Apackage specification contains only basic <package body> ::= 


declarative items (no bodies allow package body <package_simple_name> is 


* The user ‘imports’ the package resources 


[<declarative_part>] 
« The package ‘exports' the resources : 
th bility of i 

* The 'with' clause gives the user visibility o 

the package ptt be (dotted notation must <sequence_of_statements> 

be used) : 

[exception 

* The ‘use’ clause gives the user direct visibility ' 

of the package resources (simple names can <exception_handler> 


be used) {<exception_handler>}]] 


end [<package_simple_name>); 


with COMPLEX; use COMPLEX; 
procedure SAMPLE is 

NUMBER_1, NUMBER_2 : NUMBER; 
begin 


‘NUMBER_1 := NUMBER_1 * NUMBER_2; 
end SAMPLE; 
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ee ee ae ace ge ee 
SAGRABEGODIER PACKAGE BODIES 
« IF AUNIT (subprogram, package, task, generic ‘ 
SEECEIGATION OCCURS INTHE PASKAGE ieee an ne 
OCCUR IN THE PACKAGE BODY. function “+" (X,Y : NUMBER) return NUMBER is 
+ IF THERE ARE NO SUCH UNIT SPECIFICATIONS IN THE BESE SE EE 
PACKAGE SPECIFICATION, THE PACKAGE BODY IS in 
OPTIONAL. ORESULT.REAL_PART := 
* THE OPTIONAL SEQUENCE OF STATEMENTS INTHE pei Rearing 
RESULT. IMAGINARY PART := 
THE PACKAGE IS ELABORATED. X.IMAGINARY_PART + Y.IMAGINARY_PART; 
+ IF THE PACKAGE IS TEXTUALLY NESTED IN THE 
DECLARATIVE PART OF SOME OTHER UNIT, THEN wa 


BODY STUS AND THE PROPER AODYy CaN aE OA function "* (XY : NUMBER 
COMPILED SEPARATELY AS A SUBUNIT. es DEESRUMGER 
rea eee PART - Y.REAL, PART 
MAGNA Ear wy canine? PART); 
end “."; - , ~ ’ 
function "*".. 


end COMPLEX; 
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BODIES WITH A BLOCK STATEMENT 


package RANDOM is 
function NUMBER retum FLOAT; 
end RANDOM; 


with TEXT_IO; 
package body RANDOM Is 


SEED : INTEGER; 
package INT_IO Is new TEXT_IO.INTEGER_IO (INTEGER); 
function NUMBER return FLOAT is 
end NUMBER; 
begin 


TEXT_!O.PUT_LINE (“enter 5-diglt odd number:"); 
INT_IO.GET(SEED); 


— error checking routine 


end RANDOM; 
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package INT_STACK_INFO is 
type STACK is limited private; 


procedure PUSH (ITEM: in INTEGER; 
ON tin out STACK); 


procedure POP (ITEM : out INTEGER; 
FROM : in out STACK); 


EMPTY_STACK, 
FULL_STACK — : exception; 


private 
type STACK is... 
end INT_STACK_INFO; 
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PRIVATE TYPES 


* THE USER OF A LIMITED PRIVATE TYPE CAN 
ONLY USE THE PROVIDED (EXPORTED) 
OPERATIONS 


* THE USER OF A PRIVATE TYPE CAN, 
ADDITIONALLY USE THE (IN)EQUALITY AND 
ASSIGNMENT OPERATIONS 


¢ THE IMPLEMENTOR OF THE PRIVATE TYPE HAS 
- NO SUCH RESTRICTIONS WHEN WRITING THE 
PACKAGE BODY 


* THE FOLLOWING BASIC OPERATIONS ARE ALSO 
NOT ALLOWED WHEN USING PRIVATE TYPES: 


. Dynamic allocation 

. Test for membership 
A short-circuit control form 
Component selection 
. Compnent indexing 
Slice 

. Qualification 

Type conversion 

. Literals 

10. Aggregates 

11. Attributes 


OONOAAOMs 
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NAMED COLLECTION OF DECLARATIONS 


* Package body is optional 
package DATE_INFO Is 


type DAY_NAME Is ( MON, TUE, WED, THU, 
FRI, SAT, SUN); 


type DAY_VALUE Is range 1... 31; 


type MONTH_NAME Is ( JAN, FEB, MAR, APR, 
MAY, JUN, JUL, AUG, 
SEP, OCT, NOV, DEC); 


type YEAR_VALUE is range 0 .. INTEGER'LAST; 


type DATE_TYPE is 
recor 
DAY : DAY_VALUE; 
MONTH :MONTH_NAME; 
YEAR  : YEAR_VALUE; 
end record; 


end DATE_INFO; 
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ABSTRACT STATE MACHINE 


* USED WHEN THERE IS ONLY ONE OBJECT OF A 
GIVEN TYPE 


* MAINTAINS 'KNOWLEDGE' OF THAT OBJECT WITHIN 
THE PACKAGE BODY 


* ELIMINATES NEED TO PASS OBJECT BACK AND 
FORTH VIA PARAMETERS 


package FURNACE is 
function IS_RUNNING retum BOOLEAN; 
procedure SET (TEMP : in FLOAT); 
procedure SHUT_DOWN; 
function TEMP_IS return FLOAT; 
OVERTEMP : exception; 

end FURNACE; 


OPERATIONS ON OBJECTS 


* CONSTRUCTORS 


~ ALTER THE VALUE OF AN OBJECT 
-- USUALLY A PROCEDURE 


SELECTORS 


-- RETURN THE VALUE OF AN OBJECT 
-- USUALLY A FUNCTION 


ITERATORS 


-- PROVIDE A MECHANISM TO VISIT ALL OBJECTS 
~ IMPLEMENTED AS A PRIVATE TYPE AND 


--- A MEANS OF INITIALIZATION THE ITERATOR 
-- A MEANS OF RETRIEVING AN OBJECT 

--- A MEANS OF INCREMENTING THE ITERATOR 
--- AMEANS OF DETERMINING COMPLETION 
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ABSTRACT DATA TYPE 


+ USED WHEN THERE ARE MORE THAN ONE OBJECT 
OF A GIVEN TYPE 


*« NO INFORMATION ABOUT THE INDIVIDUAL OBJECT 
IS MAINTAINED IN THE PACKAGE BODY 


* ESAT SLAB ORAS 
package FURNACE_STUFF is 
type FURNACE is .. . 
function IS_RUNNING (F : FURNACE) return BOOLEAN; 
procedure SET (F: in out FURNACE; TEMP : in FLOAT); 
procedure SHUT_DOWN (F : in FURNACE); 
function TEMP_IS (F : FURNACE) retum FLOAT; 
OVERTEMP : exception; 
end FURNACE_STUFF; 
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QUEUE PACKAGE 


package QUEUE_OF_INTEGERS Is 


type QUEUE |s private; 
function MAKE return QUEUE; 
procedure ADD (INT: in INTEGER; TO : In out QUEUE); 
procedure REMOVE (INT : out INTEGER: FROM : In out QUEUE); 
function SIZE_OF (Q: QUEUE) retum NATURAL 


Procedure INITIALIZE _ITERATION; 
function NEXT_VALUE_OF_ITERATION return INTEGER; 
function TTERATION_IS_COMPLETE return BOOLEAN; 


QUEUE_FULL, QUEUE_EMPTY, ITERATION_ERROR : exception; 
Private 


type QUEUE is... 
end QUEUE_OF_INTEGERS; 
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en ere 
package BOUNDED_LENGTH_STRING is 


type TEXT is private; 
MAX_SIZE : constant = 1000; 
type SIZE is range 0 .. MAX_SIZE; 


INDEX Is je 0 .. MAX_SIZE; 
sa an INDEX of 0 reflects a failed search 


INDEX_ERROR, SIZE_ERROR : exception; 
procedure INSERT 

(SUB_TEXT : TEXT; ORIGINAL : in out TEXT; START : INDEX); 
procedure INSERT 

(SUB_TEXT : STRING; ORIGINAL : in out TEXT; START : INDEX); 


-- The SUB_TEXT is inserted into the ORIGINAL text beginning 
~ at START. SIZE_ERROR or INDEX_ERROR can occur. 


procedure DELETE 
(ORIGINAL : in out TEXT; START : INDEX; COUNT : SIZE); 


-- COUNT characters are removed from the ORIGINAL text 
~ beginning at START. SIZE_ERROR or INDEX_ERROR 
-- can occur. 


function "&" (HEAD : TEXT; TAIL : TEXT) return TEXT; 


— the TAIL is catenated to the back of the HEAD. 
~ SIZE_ERROR can occur. 


function COPY (SOURCE : TEXT; START : INDEX; COUNT : SIZE) 
retum TEXT; 
- Retums text composed by selecting COUNT characters 


~ from the SOURCE text beginning at index START. 
~ INDEX_ERROR or SIZE_ERROR can occur 
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Read in a string of TEXT. Replace the first 


occurrence (if any) of "FRAMUS” BY 
“"PHONORTON". Print out the resulting TEXT. 
Treat any exceptions which might arise. 
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function LENGTH (SOURCE : TEXT) return SIZE; 
~ Retums current size of the SOURCE. 


function POS ( PATTERN : STRING; 
SOURCE : TEXT; 
START — : INDEX := 1) return INDEX; 
~ Returns the beginning location of the first occurrence of PATTERN 


— following the START index within the SOURCE text. Returns 
~ Zero if no match is found. INDEX_ERROR 


function CREATE ( 


~ Reads a string from the user and conver 


procedure PUT (ITEM = 


~ Prints an object of TEXT and issues a new line. 


private 
type TEXT is... 
end BOUNDED_LENGTH_STRING; ! 4 1 
| Ls ; ! Ve } 
prvile tp AOL no- Yad 
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Read in a string of TEXT and print it out one 
word per line. Assume that the string has 

no leading or trailing blanks and that there 
is precisely one blank between each word. 
Guard against the input of an empty string. 
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——_— eee 
private 


LIST_TYPE |s array (INDEX range <>) of CHARACTER; 


type TEXT Is 
record 
LENGTH :SIZE; 
LST :UIST_TYPE (1 .. MAX_SIZE); 
end record; 


end BOUNDED_LENGTH_STRING; 


- K = ARBITRARY_MAXIMUM = 1000 
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——— 


package body BOUNDED_LENGTH_STRING Is 


— The first two bodies are proper bodies and are actually 

~ Implemented by coverting the STRING to a TEXT via the CREATE 

— routine and then calling the overloaded routines. This satisfies the 

-- rule that all subunit names having the same ancestor Ilbrary unit must 
~ be unique. 


procedure INSERT(SUB_TEXT : in STRING; 
ORIGINAL: in out TEXT; 
START : in INDEX) Is 
In 


INSERT (CREATE (SUB_TEXT), ORIGINAL, START); 
end INSERT; 


function POS(PATTERN : STRING; SOURCE : TEXT; START:INDEX ‘= 1) 
retum INDEX is 


begin 
retum POS (CREATE (PATTERN), SOURCE, START); 
end POS; 


~ The following function Is Included as a proper body because of the rule 
— that the names of all compilation units must be Identifiers. if the body 

— had been Implemented as a body stub, then the corresponding subunit, 
— acompilaiion unit, would be an operator symbol and not an Kentifier 


function “&"(HEAD : TEXT; TAIL : TEXT) retum TEXT fs 
NEW_TEXT : TEXT; 
begin 
NEW_TEXT.LENGTH ‘= HEAD.LENGTH + TAILLENGTH; 
NEW_TEXT.LIST (1 .. INDEX (NEW_TEXT.LENGTH)) = 
HEAD.LIST (1 .. INDEX (HEAD. LENGTH) & 
TAILUST (1.. INDEX(TAILLENGTH)); 
return NEW_TEXT; 
exception 
when constralnt_error => raise SIZE_ERROR; 
end "8"; 


- Allother subprogram bodies can be implemented as body stubs 
-- and could be Inserted here. 


end BOUNDED_LENGTH_STRING; 
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LADY == LADY & CREATE (BYRON); 


fiexaTa J [ust 
1 2: 3s 4 6 6 7 8 


DELETE (LADY, 2, 4); 


SPOT : INDEX ‘= POS ("RO", LADY); 


Ee] 


LNG : SIZE = LENGTH (LADY); 


aul 
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separate (BOUNDED_LENGTH_STRING) 

procedure DELETE ( ORIGINAL : In out TEXT; 
START =: INDEX; 
COUNT: SIZE) s 


TAIL_START : INDEX; 
TAIL_SIZE : INDEX; 
begin 
If START notin 1 .. INDEX (ORIGINAL LENGTH) then 
raise INDEX_ERROR; 
end If; 
{COUNT > ORIGINAL. LENGTH - SIZE (START) +1 then 
raise SIZE_ERROR; 
end If; 


TAIL_START ‘= START + NDEX(COUNT); 
TAIL_SIZE = INDEX(ORIGINAL.LENGTH) - TAIL_START +1; 


ORIGINALLIST (START .. START + TAIL_SIZE-1) := 
ORIGINALLIST (TAIL_START .. TAIL_START + TAIL_SIZE - 4); 


ORIGINAL LENGTH ‘= ORIGINALLENGTH - COUNT; 
end DELETE; 
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with TEXT_IO; 
separate (BOUNDED_LENGTH_STRING) 
procedure PUT (ITEM : In TEXT) Is 
begin 
TEXT_IO.PUT (STRING (ITEMLLIST (1 .. INDEX (ITEM.LENGTH)))); 
end PUT; 


type conversion 


type STRING Is array (POSITIVE range <>) of CHARACTER; 
type LIST_TYPE Is array (INDEX range <>) of CHARACTER; 
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RESTRICTED VIEW OF RESOURCES 


USER _1 


me 


USER_2 


a 


* Q:IS IT POSSIBLE TO EXPORT ONLY TYPE A AND 
SUBPROGRAM X TO USER_1 AND TO EXPORT 
ONLY TYPE B AND SUBPROGRAM Y TO USER_2? 


BIG_PACK 
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.| DATABASE SYSTEM ARCHITECTURE 


Conceptual View 


STORED DATA BASE 
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i 


with BIG_PACK; 
package VIEW_1 Is 

type Als new BIG_PACK.A; 

Procedure X (...) renames BIG_PACK.X; 
end VIEW_1; 


with BIG_PACK; 
package VIEW_2 is 
type B Is new BIG_PACKB; 
procedure Y (...) renames BIG_PACK.Y; 


end VIEW_2; 
USER _1 VIEW 1 
= = BIG_PACK 
fe 
Cs) 
USER_2 VIEW_2 Ez 
= 


‘skin’ 
packages 
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GENERIC PROGRAM UNITS 


DEFINE HIGH LEVEL TEMPLATES (MACROS) 


+ ALLOW Ada SUBPROGRAMS AND PACKAGES 
TO BE PARAMETERIZED 


* ENCOURAGE DEVELOPMENT OF GENERAL PURPOSE 
UBRARIES OF REUSEABLE SOFTWARE 


* ALLOW TRANSLATION/ELABORATION TIME 
FACTORIZATION SIMILAR TO THE EXECUTION 
TIME FACTORIZATION ACHIEVED WITH SUBPROGRAMS 
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Which is the smallest in each of the arrays? 


type MY_LIST Is array (1..5) of INTEGER; 
THE_LIST : MY_LIST = (17, -4, 7, 0, 22); 


THE_LIST 


ron =— 


SUBTYPE SHORT_WEEK !S DAYS range MON .. THU; 
type WORK_TYPE Ie array (SHORT_WEEK) of CHARACTER; 


THE_WEEK : WORK_TYPE := ('Q’, ‘A’, 'D', ‘S'); 
THE_WEEK 
MON["@] 
TUE 
WED|O" | 
THU ['S" | 
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GENERIC PROGRAM UNITS 


+ A‘GENERIC DEFINITION’ INCLUDES GENERIC 
PARAMETERS AND FORMS A PREFIX TO PROGRAM 
UNIT SPECIFICATIONS 


+ A‘'GENERIC INSTANTIATION' CREATES A PROGRAM 
UNIT FROM A TEMPLATE 


* GENERIC PARAMETERS CAN BE TYPES, VALUES, 
AND SUBPROGRAMS 


generic 


ra parameters Naw 


PI & 


201 Software Engineering with Ada 202 


type ABC Ie (‘A’, 'B', °C’); 
type DATE_LIST is array (ABC) of DATE_TYPE; 
THE_DATES : DATE_LIST := ('A' => (4, JUL, 1776), 


‘B' => (19, JUN, 1963), 
'C’ => (1, DEC, 1822)) 


THE_DATES 
" 
Q: Which is the 
‘smallest date? 
'B 
c 
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An algorithm for finding the smallest 
eleciari in an integer array 


procedure SAMPLE Is 


type INDEX_SIZE Is range 1 .. 5; 

type LIST Is array (INDEX_SIZE) of INTEGER; 

functlon SMALLEST_INT (L : LIST) retum INTEGER Is 
RESULT : INTEGER ‘= L (LFIRST); 

begin 


for INDEX In L'RANGE 
loop 


if L(INDEX) < RESULT then 
RESULT := (INDEX); 
end If; 
end loop; 
retum RESULT; = send it back to caller 
end SMALLEST_INT; 


begin ~ SAMPLE 
end SAMPLE; 
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Asimilar algorithm: 
subtype ALPHA Is character range ‘a’. . ‘f; 
type MY_REC Is 

record 


AGE : NATURAL; 

GPA : FLOAT; 

IS_RESIDENT : BOOLEAN; 
‘end record; 


type STUDENTS ks array (ALPHA) of MY_REC; 


- But, “<" Is not a primitive operation on record types. 
- Therefore, we must provide the capability. In 

-- thls case we will define a ‘less-than' operation on 
-- the age components of the records. 


function LESS (X, Y : MY_REC) retum BOOLEAN |s 
in 
retum X.AGE < Y.AGE; 
end; 
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GENERIC SPECIFICATION 


generic J 
type INDEX_TYPE bs (=); 
type BASE_TYPE ks private; 
type ARRAY_’ TYPE erary (HDEX TYPE} of BASE TYPE: 
with function “<" (L, R : BASE_TYPE) retum BOOLEAN |s. Bop 


function LEAST (L : ARRAY_TYPE) retum BASE_TYPE; 


GENERIC BODY 


function LEAST (L : ARRAY_TYPE) retum BASE_TYPE Is 
RESULT : BASE_TYPE ‘= L (L'FIRST); 
begin 


for INDEX In L'range 
boop 


If (INDEX) < RESULT then 
RESULT ‘= L(INDEX); 
end If, 
end loop; 
tetum RESULT; 
end LEAST; 
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GENERIC INSTANTIATIONS 


function SMALLEST_INT Is new LEAST (INDEX_TYPE => INDEX_SIZE, 
BASE_TYPE => INTEGER, 
ARRAY_TYPE => LIST); 


function SMALLEST_REC Is new LEAST (INDEX_TYPE => ALPHA, 
BASE TYPE => MY_REC, 
ARRAY_TYPE »> STUDENTS, 
"S »=> LESS); 


LEAST 
SOO 
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A GENERIC STACK PACKAGE 


generic 
type ELEMENT is private; 
package STACK_PACK is 


procedure PUSH (OBJECT : in BENT, 
procedure POP (OBJECT: outELEMENT); 


EMPTY, FULL : exception; 
end STACK_PACK; 
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GENERIC TYPE PARAMETERS 


* TO MATCH ANY TYPE me OPERATIONS) 
type <Ident> Is limited private; 


* TO MATCH ANY TYPE PERMITTING ASSIGNMENT 
AND TEST FOR (IN)EQUALITY 
type <ident> Is private; 


* TO MATCH AN ACCESS TYPE 
type <ident_1> is access <ident_2>; 


* TO MATCH ANY DISCRETE TYPE 
type <ident> is (<>); 


* TO MATCH NUMERIC TYPES 
type <ident> Is range <>; 
type <ident> is delta <>; 
type <ident> is digits <>; 


* TO MATCH ANY CONSTRAINED ARRAY 
type <ident_1> is array(<ident_2>) of <ident_3>; 


* TO MATCH ANY UNCONSTRAINED ARRAY 
type <id_1> is array (<id_2> range <>) of <id_3>; 
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package body STACK_PACK is 


MAX ary 7 be 
TOP :NA = 0; 
STACK : array (1 .. MAX) of ELEMENT; 


i PUSH (OBJECT : in ELEMENT) is 
in 


lf TOP = MAX then 
raise FULL; 


TOP := TOP + 1; 
STACK (TOP) := OBJECT; 


end PUSH; 
eens POP (OBJECT : out ELEMENT) is 
in 


if TOP = 0 then 

raise EMPTY; 
OBJECT := STACK (TOP); 
TOP := TOP - 1; 


end POP; 
end STACK_PACK; 
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GENERIC OBJECT PARAMETERS 


generic 
MAX: in POSITIVE; — -- generic formal OBJECT parameter 
type ELEMENT is private; 
package STACK_PACK is 
procedure PUSH (OBJECT :in ELEMENT); 
Picoue POP (OBJECT : out ELEMENT); 
MPTY, FULL : exception; 
end STACK_PACK; 


package body STACK_PACK is 


TOP: NATURAL := 0; 
STACK: array (1 .. MAX) of ELEMENT; 


procedure PUSH .. . 
procedure POP... 


end STACK_PACK; 


-- generic instantiations 


Package INT_STACK Is new STACK_PACK 
(MAX => 50, ELEMENT => INTEGER); 


package CHAR_STACK Is new STACK_PACK 
(100, CHARACTER); 
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DEVELOP A GENERK SET CAPABILITY 


* SETS ARE DRAWN FROM SOME DISCRETE UNIVERSE 
+ SETS CAN BE ASSIGNED VALUES 


« THE UNION OF TWO SETS IS A THIRD SET CONTAINING 
ALL ELEMENTS WHICH ARE IN EITHER THE FIRST 
SET OR THE SECOND SET 


+ THE INTERSECTION OF TWO SETS IS A THIRD SET WHICH 
CONTAINS ALL ELEMENTS WHICH ARE IN BOTH THE 
FIRST SET AND THE SECOND SET 


¢ THE DIFFERENCE BETWEEN TWO SETS IS A THIRD SET 
WHICH CONTAINS ALL ELEMENTS WHICH ARE IN THE 
FIRST SET AND NOT IN THE SECOND SET 


+ ASET‘A' IS ACOMMON SUBSET OF A SET’B' IF 
AND ONLY IF ‘A’ IS EQUAL TO THE INTERSECTION 
OF ‘A’ AND ''B' 


* ASET‘A' IS A PROPER SUBSET OF A SET ‘B' IF 
AND ONLY IF 'A’ IS A COMMON SUBSET OF 'B' AND 
‘A’ IS NOT EQUAL TO'B' 


+ FOR EVERY ELEMENT ‘e' OF A GIVEN UNIVERSE AND 
SET ‘S' OF THE SAME UNIVERSE, EITHER ‘e' IS A 
MEMBER OF S OR ‘e' IS NOT A MEMBER OF ''S’ 


* THE CARDINALITY OF A SET IS THE NUMBER OF 
ELEMENTS CURRENTLY IN THE SET 


+ THE NULL SET IS THE SET CONTAINING NO ELEMENTS 
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OBJECTS AND OPERATIONS 


° SET 
-- assignment 
-- (Inequality 
-- Intersection : 
-- Union + 


-~ Difference - 


— Proper Subset < 
-- Common Subset <= 
-- Membership 

~ Cardinality 


¢ NULL_SET 
¢ UNIVERSE 
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generic 
type UNIVERSE Is (<>); 
package SET_ PACKAGE is 


type SET fe private; 


NULL_SET : constant SET; ~ deferred 


function ASSIGN (ELEMENT : UNIVERSE) return SET; 
function ASSIGN (FROM,TO +: UNIVERSE) return SET; 


function “*" (SET_1, SET_2 : SET) return SET; 
function “+” (SET_1, SET_2 : SET) return SET; 


function "+" (SET_1 — : SET; 
ELEMENT : UNIVERSE) return SET; 


function "+" (ELEMENT : UNIVERSE; 
SET_1 : SET) return SET; 


function “-" (SET_1, SET_2 : SET) return SET; 


function "-" (SET_1 : SET; 
ELEMENT : UNIVERSE) return SET; 


function “«" (SET_1, SET_2 : SET) return BOOLEAN; 
function “<=” (SET_1, SET_2 : SET) return BOOLEAN; 


function IS_A_LMEMBER (ELEMENT : UNIVERSE; 


OF_SET : SET) return BOOLEAN; 


function CARDINALITY (S :SET) return NATURAL; 


private 


end SET_PACKAGE; 
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GENERIC PACKAGE BODY LOGICAL OPERATIONS ON BOOLEAN ARRAYS 
* Indistinguishable from a routine package body . edoscaied eeerenis enaT, ANG OF =“ pons Just 
except that all reference is to generic parameters pele typos boolaar as tey are Ablliiad 


f type ‘boolean’. 
+ Can take {al evenings of actual pilvats type objects of type 
Hi sal ree a alain la type BOOLS le array (1 .. 4) of BOOLEAN; 


T : constant BOOLEAN := TRUE; 
F : constant BOOLEAN := FALSE; 


A :BOOLS :«(f,T, F, F); 
-- all bodies of subprograms whose specification B : BOOLS :=(T, F, T, F); 
-- appeared in the Cadeags spec must be included ; 
-- here. They could be included as stubs and then 
- be completed as subunits and separately compiled. 


package body SET_PACKAGE is 


end SET_PACKAGE; A B notA AandB 
rfr}aft tte] a{r| 
afrj2]r | afr] 2] F | 
syria {t| s{r] 3] F | 
ate yayrl apt] afr] 
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* THIS CAPABILITY (BOOLEAN OPERATIONS ON BOOLEAN 
ARRAYS) LEADS US TO A VERY NATURAL DATA 
STRUCTURE FOR SETS 

private 


type SET Is array (UNIVERSE) of BOOLEAN; 
NULL_SET : constant SET := (others => FALSE); 


end SET_PACKAGE; 
* Consider the following application: 


type NORDEN Is (DK, S, N, SF); 
package NORTH_SET is new SET_PACKAGE (NORDEN); 
use NORTH_SET, 


A,B,C, SCANDINAVIA : NORTH_SET.SET; 
‘A: ASSIGN (FROM => DK, TO => S); 


B := ASSIGN (DK) +N; 
C=A‘B; 
SCANDINAVIA := A + B; 
c SCANDINAVIA 
DK} T 


{DK} {DK,S,N} 
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IMPLEMENTATION 


function “*" (SET_1, SET_2 : SET) return SET is 
begin 

° return (SET_1 and SET_2); 
end; 


jncien "4" (SET_1, SET_2 : SET) return SET is 
agin 

return (SET_1 or SET_2); 
end; 


function "+" (SET_1: SET; 
ELEMENT : UNIVERSE) retum SET is 
RESULT : SET := SET_1; 
agin 
RESULT (ELEMENT) := TRUE; 


return RESULT; 
end; 


function "+" (ELEMENT : UNIVERSE; 
ET_1 : SET) return SET is 


begin 
return SET_1 + ELEMENT; 
end; 
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function IS_A_| Bee te SND: UNIVERSE; 
pe ET : SET) ratum BOOLEAN is 
agin 


retum OF_SET (ELEMENT); 
end; 
function CARDINALITY (S : SET) return NATURAL is 
TOTAL : NATURAL := 0; 
begin 


for INDEX In UNIVERSE 
loop 


If S (INDEX) then 
a TOTAL + 1; 
end loop; 
return TOTAL; 
end CARDINALITY; 
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Loki "" (SET_1, SET_2 : SET) retum SET is 
agin 

retum (SET_1 and (not SET_2)); 

end; 


function "-" Cr : SET; 
ELEMENT : UNIVERSE) retum SET is 


RESULT : SET := SET_1; 


egin 
RESULT EEN = FALSE; 
4 retum RESULT; 
end; 


lang "<=" (SET_1, SET_2 : SET) retum BOOLEAN is 
agin 

retum SET_1 = SET_1 * SET_2; 
end; 


on "<" (SET_1, SET_2 : SET) return BOOLEAN is 
egin 

F return (SET_1 <= SET_2) and (SET_1 /= SET_2); 
end; 
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* The assignment (replacement) operation (- is 
ae since type SET is private and not limited 
private 


* The abllity to an an element or a range of 
elements to a set Is also helpful 


in ASSIGN (ELEMENT : UNIVERSE) return SET is 
agin 

jenn (ELEMENT => TRUE, others => FALSE); 
en 


late ASSIGN (FROM, TO : UNIVERSE) return SET is 
egin 


return (FROM .. TO => TRUE, others => FALSE); 
end ASSIGN; 
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INPUT/OUTPU 


« IN ADA, VO IS HANDLED VIA PACKAGES WHICH 
COME WITH THE LANGUAGE 


SEQUENTIAL_IO OIRECT_IO LOW_LEVEL_IO 


CHARACTER 
& INTEGER_IO 
STRING 
FIXED_!O 
FLOAT_IO 
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OPERATIONS ON FILE OBJECTS 
+ OPERATIONS ON ALL FILES 
procedures functions 
CREATE MODE ~ FILE_MODE 
OPEN NAME -- STRING 
CLOSE FORM ~ STRING 
DELETE IS_OPEN ~ BOOLEAN 
RESET END_OF_FILE ~ BOOLEAN 


+ OPERATIONS ON SEQUENTIAL AND DIRECT FILES ONLY 
procedures 
READ 
WRITE 

+ OPERATIONS ON DIRECT FILES ONLY 


procedures =i sss: 


SET_INDEX INDEX — POSITIVE_COUNT 
SIZE -- COUNT (FROM 0) 


ENUMERATION_IO 
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FILE OBJECTS 
eo “007K 
Z es 
FILE EXTERNAL 
OBJECT FILE 


pe FILE_TYPE |s limited private; 
type FILE_MODE Is (IN_FILE, OUT_FILE); 


procedure CREATE (FILE: Inout FILE_TYPE; 
‘ MODE :in FILE_MODE := default; 
NAME :inSTRING:="; 
FORM :in STRING :="); 
procedure OPEN (FILE : Inout FILE_TYPE; 
‘ MODE. : In FILE_MODE; 


NAME :In STRING; 
FORM :in STRING :="); 


— opening a file: 


FRAMUS : TEXT_IO.FILE_TYPE; -- Declaration 
JEXT_IO.OPEN (FRAMUS, TEXT_IO.IN_FILE, "FOO.TXT); _-- Statement 
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package TEXT_IO 


+ PROVIDES VO FOR CHARACTERS AND STRINGS 


* CONTAINS GENERIC PACKAGES FOR: ENUMERATION_IO, 
FIXED_10, FLOAT_IO, INTEGER_IO 7 


+ FILE LAYOUT 
-- A file ls a sequence of pages (numbered from 1) 
- A page Is a sequence of lines (numbered from 1) 
- Allne Is a sequence of characters (columns) 


SOURCE: ‘Ada as a second language’ by Ni 
ceevectic oe guage’ by Norman H. Cohen 
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STANDARD FILES 


* IMPLEMENTATION DEFINED 
+ INPUT (USUALLY KEYBOARD) 
* OUTPUT (USUALLY CRT) 


DEFAULT FILES 


« INITIALLY, THE STANDARD FILES 
CAN BE CHANGED DURING EXECUTION 


* I/O OPERATIONS CAN NAME A SPECIFIC FILE 
OR CAN RELY ON THE DEFAULT FILE 
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V0 FOR OTHER SCALAR TYPES 


+ ASSUME THE FOLLOWING TYPE DECLARATIONS 


type GENDER is eer: peMeleh 
type SIZE is range 1. 


* THESE INSTANTIATIONS ARE NECESSARY IN 
ORDER TO HAVE VO 


package GENDER IO isn 
TEXT_IO. ENUMERATION |_IO(GENDER); 
package SIZE_IO Is new 
“TEXT_IO.INTEGER_IO(SIZE); 
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TEXT_IO OPERATIONS 


+ OPERATIONS ON OUT_FILE 


procedures functions 
PUT LINE_LENGTH 
SET_LINE_LLENGTH PAGE_LENGTH 
NEW_LINE COL 
NEW_PAGE LINE 
SET_COL PAGE 
SET_LINE 
SET_PAGE 

* OPERATIONS ON IN_FILE 
procedures functions 
SKIP_LINE END_OF_LINE 
SKIP_PAGE END_OF_PAGE 
SET_COL COL 
SET_LINE LINE 
GET PAGE 

* OPERATIONS FOR VO OF STRINGS ONLY 
procedures 
GET_LINE 
PUT_LINE 
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VO EXCEPTIONS 


package IO_EXCEPTIONS is 
STATUS_ERROR _ : exception; 


MODE_ERROR : exception; 
NAME_ERROR : exception; 


USE_ERROR : exception; 
DEVICE_ERROR __ : exception; 
END_ERROR : exception; 
DATA_ERROR : exception; 


LAYOUT_ERROR _ : exception; 


end |O_EXCEPTIONS; 


VO PACKAGES USE renames TO 
EXPORT EXCEPTIONS 
with |O_EXCEPTIONS; 


package TEXT_IO is 


‘USE_ERROR : exception renames 
IO_EXCEPTIONS.USE_ERROR; 


end TEXT_IO; 
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SAMPLE VO PROGRAM 


+ THE FOLLOWING PROGRAM READS INTEGERS 
FROM AN EXISTING FILE (FOO.TXT), CALCULATES 
THE SUM AND OUTPUTS THE SINGLE INTEGER 
RESULT TO A NEW FILE ("RESULT.TXT) 


with TEXT_IO; 
procedure BUM UP Is 


package INT_IO is new TEXT_IO.INTEGER_KX{INTEGER); 
INPUT_NUMBERS : TEXT_IO.FILE_TYPE; 
RESULT : TEXT_1O.FILE_TYPE; 
SUM : INTEGER >= 0; 
NUMBER : INTEGER; 
in 
TEXT_IO.OPEN (INPUT_NUMBERS, TEXT_IO.IN_FILE, "FOO.TXT); 
TEXT_IO.CREATE (RESULT, TEXT_10.OUT_| FILE, "RESULT.TXT); 
while not TEXT_IO.END_OF_FILE (INPUT_NUMBERS) 
INT_IO.GET (INPUT_NUMBERS, NUMBER); 
SUM o= SUM + NUMBER; 
end loop; 
INT_tO0.PUT (RESULT, SUM); 


TEXT_IO.CLOSE (INPUT_NUMBERS); 
TEXT_IO.CLOSE (RESULT); 


end SUM_UP; 
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the GET_LINE operation 


+ Aroutine to input two words and output them 
one word per line (assumes exactly two words) 


with TEXT_IO; 
procedure 10_! SAMPLE is 


SOURCE : STRING (1 
: NATURAL; 


SPOT : 
COUNT :NATURAL; 


-- 60); 


begin 
TEXT_IO.GET_LINE (SOURCE, COUNT); 
SPOT := 1; 


loop 
exit when dpa ee s' 
SPOT := SPOT + 


end loop; 


TEXT_IO,PUT_LINE (SOURCE (1 .. SPOT - 1)); 
TEXT_IO.PUT_LINE (SOURCE (SPOT+1. . COUNT)); 


end |O_SAMPLE; 
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TEXT_IO FORMAT OPTIONS 


INT_IO.PUT (17, WIDTH => 5); 
INT_IO.PUT (17, BASE => 8); 
FLT_IO.PUT (17.5, FORE => 3, AFT => 2); 
FLT_IO.PUT (17.5, EXP => 3); 
ENUM_IO.PUT (NORMAL, WIDTH => 8); 
ENUM_IO.PUT (DOWN, LOWER_CASE); 
TEXT_IO.PUT ('A’); 

package CHAR_IO Is new 
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-- bbb17 

-- 8H21# 

-- 617.50 

-- 1.75E+01 
-- NORMALbb 
-- down 


-~A 


TEXT_IO.ENUMERATION_IO (CHARACTER); 


CHAR_IO.PUT (‘A’); 


AY 
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ENTITIES WHOSE EXECUTIONS PROCEED IN 
PARALLEL 


CAN BE CONSIDERED TO EXECUTE ON THEIR 
OWN LOGICAL PROCESSOR 


DIFFERENT TASKS PROCEED INDEPENDENTLY, 
EXCEPT AT POINTS WHERE THEY SYNCHRONIZE 


VARIOUS ACTUAL IMPLEMENTATIONS 


+ MULTICOMPUTERS 
-- MULTIPROCESSORS 
+ INTERLEAVED EXECUTION 
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TASK DEPENDENCE 


EACH TASK DEPENDS ON AT LEAST ONE MASTER 
A MASTER CAN BE 


~ ATASK 

-- ABLOCK STATEMENT 
-- ASUBPROGRAM 

-- ALIBRARY PACKAGE 


~-TASK -- SUBPROGRAM 
Saar 


-- PACKAGE -- BLOCK STMT 
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TASK CONSIDERATIONS 


*« HOW IS A TASK ACTIVATED? 

« HOW IS A TASK TERMINATED? 

*« HOW DO TASKS COMMUNICATE? 

¢ WHAT ABOUT DEADLOCK? 

* CAN ATASK TIME OUT’? 

« IS THERE A PRIORITY SCHEME? 

« HOW IS 'SHARED' DATA PROTECTED? 

* DO Ada TASKS ISSUE OPERATING SYSTEM CALLS? 
*« HOW DO EXCEPTIONS AFFECT TASKS? 
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TASK ACTIVATION 


A TASK DECLARED IN A <declarative_part> OF A 
SUBPROGRAM, TASK, PACKAGE OR BLOCK 
STATEMENT IS ACTIVATED 


AFTER THE PARENT {S ELABORATED AND 
BEFORE THE PARENT BEGINS EXECUTION 


A TASK WHOSE SPECIFICATION APPEARS INA 
PACKAGE SPECIFICATION IS ACTIVATED 


AFTER THE PACKAGE BODY IS ELABORATED 
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DYNAMIC TASK ACTIVATION 


A TASK CAN BE ACTIVATED DYNAMICALLY VIA 
AN ALLOCATOR. 


THE MASTER OF THE ALLOCATED TASK IS THE 
UNIT WHICH CONTAINS THE ACCESS TYPE 
DECLARATION (NOT THE UNIT THAT EXECUTED 
THE ALLOCATOR). 


task type T; 


‘ype ar arenes The task accessed by P 


depends on A, not B 


P :=newT; 
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procedure MAIN is 
task type T; 
type T_PTR Is access T; 
procedure P is separate; 
task body T is separate; 
begin 
for INDEX in 1 .. 3loop 
aia es ~ Acall to procedure P 
end MAIN; 
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TASK TERMINATION 


+ COMPLETION OF EXECUTION 


~ Atask, block statement or subprogram is 
completed when its sequence of statements 
has been executed. 


-- Ablock statement Is completed when it reaches 
a goto, exit, or retum transferring control 
out of the block statement. 


-- A procedure or function is completed upon 
executing aretum. 


- Atask, block statement or subprogram Is completed 
when an exception is raised and there is no 
handler or, after handling the exception. 


TERMINATION OF TASKS 


-- Atask with no dependent tasks terminates 
upon completion. 


-- A task with dependents terminates when it 
is completed and all its children are terminated. 


-- Ablock statement or subprogram which is 
complete is not left until all of its children 


tasks are terminated. 
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separate (MAIN) wad \ ‘ 
procedure P is -- version 1 { -) iy Son _ 
\ Ue 
T_ARRAY : array (1... 3) of T; \ 2 
begin \ Nee 
| 
! a» | } " 
deales } om vase ada 
LEE Rae ay a 
separate (MAIN) “) 
procedure P is --version2 = / "D> 
T_ARRAY: array (1 ..3) of T.PTR; > 
begin [ pe }A as &, 


for lin 1 .. 3 loo) 
T_ARRAY ( ) t= new T; \ 


end loop; } Ae r¢2. Us Me. 
/ 
end P; / 


HOW MANY TASKS ARE ACTIVE AT ONCE? 
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TASK ENTRIES 


TASKS COMMUNICATE VIA CHANNELS 
CALLED ENTRIES. 


AN ENTRY OF A TASK IS ANALOGOUS TO 
A SUBPROGRAM OF A PACKAGE. 


<task_specification> ::= 
task [type] <identifier> —_[is <) 
Loci deckbraiions} (S J 
<representation_clause>} 


end [<task_simple_name>] J; 


<entry_declaration> ::= 


entry <identifier> [(<discrete_range>)] [<formal_part>]; 
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CALLING AN ENTRY 


* TASK SPECIFICATION 
task PROTECTED_STACK Is 


entry POP (OBJECT : out FLOAT); 
entry PUSH (OBJECT : in FLOAT); 


end PROTECTED_STACK; 
« ENTRY CALLS -- must name the task 


PROTECTED_STACK.PUSH (3.1415); 
PROTECTED_STACK.POP (MY_FLOAT); 


« AN ENTRY CAN BE RENAMED AS A PROCEDURE 


procedure POP doe! : out FLOAT) renames 
PROTECTED_STACK.POP; 
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SAMPLE TASK SPECIFICATIONS 


task SERVER; 


task type SWITCH is 
entry PORT (LOW .. HIGH)(N : INTEGER); 


end; 


task PROTECTED_STACK is 
pragma PRIORITY (17); 


entry POP SaeeT ott FLOAT); 
entry PUSH (OBJECT : in FLOAT): 


end PROTECTED_STACK; 


task BEAN is 


entry COUNTER (N : in INTEGER); 
for COUNTER use at 16#1 FF#; 


end BEAN; 
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ENTRY QUEUES 


* THERE IS AN IMPLICIT QUEUE ASSOCIATED WITH 
EACH ENTRY. 


* THE FIRST TASK TO CALL AN ENTRY WILL BE THE 
FIRST TASK TO RENDEZVOUS, 


* ALL OTHER TASKS WAIT IN THE QUEUE IN ORDER 
OF ARRIVAL. 


* IT IS POSSIBLE TO LEAVE A QUEUE BEFORE BEING 
SERVED. 


+ ATASK CAN BE IN ONLY ONE QUEUE AT A TIME. 
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* ELABORATED _ -- declarations now exist 
A + RUNNING -- currently assigned a processor 


ie 7 CONSUMER 
« READY -- unblocked, waiting for a processor 
B 
Lf E * BLOCKED -- delayed or waiting for rendezvous 
£ * COMPLETED __ -- task has reached its ‘end’ 


* TERMINATED __ --all of tasks children have terminated 


procedure MAIN is 
task type PRODUCER; 


IELABORATED 
A, B, C: PRODUCER; —~. (=) 
task CONSUMER is 
entry SEND (N : in INTEGER); ~, 
end CONSUMER; BLOCKED 
task body PRODUCER is separate; ae 


task body CONSUMER is separate; 
begin Pd y 
tee - = 
end MAIN; ( Agno ‘ \ 
\ K/*e } 
A Z 
a 
—_ —————_—— 
From Aby/A neti 
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TASK PRIORITY TASK ASYMMETRY 


* ACALLING TASK MUST KNOW NAME OF CALLED 
+ STATIC VALUE Hoe ale SM (LIKE NEEDING TO 
« SETWITHAPRAGHA HO UMBER WHEN YOU CALL). 


* ACALLED TASK DOES NOT KNOW THE NAME OF 


+ ALLOWS THE TASK WITH HIGHEST PRIORITY THE 
TO MOVE FROM READY" TO RUNNING AND HE CALLER (LIKE ANSWERING THE PHONE). 
IF NEED BE, TO PREEMPT A LOWER PRIORITY * SEPARATION OF SPECIFICATION FROM BODY 
TASK ALLOWS MUTUAL CALLING OF TASKS. 

* DOES NOT AFFECT THE ORDER IN WHICH A A 
QUEUED TASK WILL BE SERVED ‘OocuRS) Reever jee DEADLOCK 


task HIGH_PRIORITY Is 
Pragma PRIORITY (7); 


entry... 
end HGH" PRIORITY; 


“It two tasks with different priorities are both eligible 
for execution and could sensibly be executed using the 
same physical processors and the same other processing 
resources, then It cannot be the case that the task with 
the lower priority Is executing while the task with the 
higher priority Is not.” 
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FAMILIES OF ENTRIES 


* ASET OF PEER ENTRIES 
* INDEXED BY A DISCRETE VALUE 
* A'ONE-DIMENSIONAL ARRAY' OF ENTRIES 


type IMPORTANCE is (LOW, MEDIUM, HIGH); 
task SWITCH ts 

entry PUT (IMPORTANCE)(MSG : In string); 
end SWITCH; 


SWITCH 


* CALLING A FAMILY MEMBER 
SWITCH.PUT (LOW) (NEW_MESSAGE); 
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TASK OBJECT DECLARATIONS 


type PROTECTED is 
record 
OBJECT : FLOAT; 
KEY :RESOURCE; 
and record; 
SAFE : PROTECTED; 
LOCK : RESOURCE; 
COLLECTION : array (1 .. 10) of RESOURCE; 


type PTR is accass RESOURCE; 
IARD : PTR; 


GUARD := new RESOURCE; -- an allocator 


TASK ENTRY CALLS 


SAFE.KEY.SEIZE; 
LOCK.RELEASE; 
COLLECTION (8).SEIZE; 
GUARD.RELEASE; 
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TASK TYPES 


* TASK TYPES ARE LIMITED PRIVATE 
-- no assignment 
-- no test for (in)equality 


task type RESOURCE is 


entry SEIZE; 
entry RELEASE; 


end RESOURCE; 
LOCK : RESOURCE; 


task LOCK is 


entry SEIZE; 
entry RELEASE; 


end LOCK; 


LOCK 
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ATTRIBUTES OF TASKS 


* T'CALLABLE 
-- Yields the value false when the task T is 
completed or terminated or aborted 


TTERMINATED 
-- Yields the value true if the task T is terminated 


E'COUNT 

-- Yields the number of entry calls presently queued 
on the entry E. Does not include the task which 
Is currently in rendezvous 


Software Engineering with Ads 253 Sottware Enginsoring with Ada 254 
cea A ae Mh eens 


TASK BODIES TASK BODIES 


+ MAY BE SEPARATELY COMPILED 


<task body> ::= 
i « MAY CONTAIN ACCEPT AND SELECT STATEMENTS 
task body <task_simple_name> is WY WELL AS hal 

[ <declarative_part> ] 
begin 

<sequencs_of_statements> task body RESOURCE is 
[ exception begin 

exception 


<excaption_handler> 
{<exception_handler>} ] end RESOURCE; 


end [ <task_simple_name> ]; 


declarations 


statements 
exception 
handlers 
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ACCEPT STATEMENTS ACCEPT STATEMENTS 


* ALWAYS CORRESPOND TO TASK ENTRIES 
* CAN DEFINE A SEQUENCE OF STATEMENTS TO BE 


<accept_statement> ::= 


EXECUTED DURING RENDEZVOUS WITH A accept <entry_simple_name> 
CALLING TASK [(<entry_index)] [formal_part] [do 
* MUST APPEAR DIRECTLY IN THE TASK BODY <sequence_of_statements> 


(NOT IN A NESTED SUBPROGRAM) 


» MUST NOT APPEAR WITHIN ANOTHER ACCEPT 
STATEMENT FOR THE SAME ENTRY OR FAMILY 
OF ENTRIES 


end [<entry_simple_names] }; 


SWITCH 


Loc 


FF accept PUT (...) do 


an 
mt (| 
- 
= 
5 
= 
~ 
= 
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PRODUCE CONSUME 
RENDEZVOUS JF 


PUT 
* THE INTERACTION THAT OCCURS BETWEEN TWO 
PARALLEL TASKS WHEN ONE TASK HAS CALLED 
AN ENTRY OF THE OTHER TASK, AND A 
CORRESPONDING ACCEPT STATEMENT IS 
BEING EXECUTED BY THE CALLED TASK ON 


BEHALF OF THE CALLING TASK. * TASK SPECIFICATIONS 
* FOR SIMPLE RENDEZVOUS, WHICHEVER TASK 
ARRIVES AT THE RENDEZVOUS POINT FIRST WILL task PRODUCE; task CONSUME is 
GO INTO A SLEEPING WAIT. entry PUT (N : INTEGER); 
end CONSUME; 
* DURING RENDEZVOUS, THE TWO TASKS ARE 
LOCKED TOGETHER 
+ UPON COMPLETION OF RENDEZVOUS, THE TWO * TASK RENDEZVOUS 
TASKS CONTINUE IN PARALLEL. 
task body PRODUCE is task body CONSUME is 
p. a CONSUME.PUT (17); accept PUT(N:INTE 
a 
nae j ieiaa cits ; end PRODUCE; end PUT; 
Af ! eae 
aa — Give, B Prev! end CONSUME; 
Wg J ne 
. { a 
° ; . f aes ee pleat J Cra 
| 
wed e] 
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ae 
CLASSES OF RENDEZVOUS SIMPLE RENDEZVOUS 
+ SIMPLE RENDEZVOUS * the customer 
* OPTIONS FOR SERVING (CALLED) TASK TELLER.DEPOSIT (ID _ => 8064, 
AMT => 100.0); 
-- Simple selective wait * the teller 
-- Selective wait with an else part tee 
~- Selective wait with guards accept DEPOSIT (ID : INTEGER; AMT: FLOAT) do 
-- Selective wait with delay alternative tes 
-- Selective wait with terminate alternative end DEPOSIT; 
+ OPTIONS FOR CALLING TASK ~ 
-- Conditional entry call 
-- Timed entry call 
CUSTOMER TELLER 


WITHORA' 


task TELLER is 
entry aati AC ET ESEES AMT : FLOAT); 
entry DRIVE_U 
entry WHHDRAW’ (.. 


end TELLER; 


COC 
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SELECTIVE WAIT ‘ 


<selective_wait> ::= 


select . 
<select_altemative> 


<select_altemative>} 
[else 
<sequence_of_statements>] 
end select; 


<select_alternative> ::= 


[when <condition> =>] _ 
<selective_wait_alternative> 


<selective_wait_alternative> ::= 


<accept_statement><sequence_of_statements>| 
<delay_alternative><sequence_of_statements>| 
terminate 


+ MUST CONTAIN AT LEAST ONE ACCEPT 
STATEMENT. 


* CAN CONTAIN (mutually exclusively) 
-- one terminate altemative, or 
-- one or more delay altematives, or 


-- an else part 
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SELECTIVE WAIT WITH ELSE OPTION wot ~) 
a 


* IF NOENTRIES PENDING, EXECUTE AN OPTIONAL 


SEQUENCE OF STATEMENTS. 


* SERVING TASK DOES NOT GO INTO BLOCKED STATE. 


select 
accept DEPOSIT (ID : INTEGER; AMT : FLOAT) do 


end DEPOSIT; 
accept DRIVE_UP (ID : INTEGER; AMT : FLOAT) do 
end DRIVE_UP; 

else 


<sequence_of_statements> 


end select; 
end loop; 
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Arar} 
SIMPLE SELECTIVE WAIT OS 


« NONDETERMINISTICALLY SELECT ONE OF SEVERAL 
POSSIBLE ENTRIES. 

ioop 
select 

accept DEPOSIT (ID : INTEGER; AMT : FLOAT) do 


end DEPOSTT; 


accept DRIVE_UP (ID ; INTEGER; AMT : FLOAT) do 
end DRIVE_UP; 


or 
accapt WITHDRAW (ID : INTEGER; AMT:out FLOAT) do 
end WITHDRAW; 


end select; 
end loop; ee: = 
ner aa — 
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ALTERNATIVES WITH GUARDS 


* ALTERNATIVES WITHOUT GUARDS ARE ALWAYS OPEN. 


* ALTERNATIVES WITH GUARDS THAT EVALUATE 
‘TRUE’ ARE OPEN. 


¢ ALTERNATIVES WITH GUARDS THAT EVALUA 
‘FALSE’ ARE CLOSED. ia 


+ IF ALL ALTERNATIVES ARE CLOSED AND TH 
NO ‘ELSE’ PART, AN EXCEPTION IS RAISED. 


loop Acai 109-e~- 


when BANKING_HOURS => 


accept DEPOSIT (ID : INTEGER; AMT : FLOAT) do 
end DEPOSIT; 
or 


when DRIVE_UP_HOURS => 


accept DRIVE_UP (ID : INTEGER; AMT : FLOAT) do 
end DRIVE_UP; 


end select; 
end loop; 
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DELAY STATEMENT 


+ SUSPENDS FURTHER EXECUTION (OF THE 
TASK THAT EXECUTES THE DELAY) FOR AT 
LEAST THE DURATION SPECIFIED BY THE 
VALUE (IN SECONDS) 


delay 10.0; 
delay 0.0001; 


» AN ALGORITHM FOR REPEATING AN ACTION 
EVERY SECOND: 


declare 

INTERVAL: constant := 1.0; 

TIME_HACK : CALENDAR.TIME := CALENDAR.CLOCK; 
begin 

loop 

delay DURATION (TIME_HACK - CALENDAR.CLOCK); 


- action to be performed 


TIME_HACK := TIME_HACK + INTERVAL; 
end loop; 
end; 


+—\time 
action —> “—— 
delay >  — — -— 
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SELECT WITH A DELAY ALTERNATIVE 


* POSSIBLE RENDEZVOUS WITH THE CLOCK 


end DEPOSIT; 

or 
delay 10.0*MINUTES; 
<sequence_of_statements> 


end select; 
end loop; 
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PACKAGE CALENDAR 


package CALENDAR is 
type TIME Is private; 


subtype YEAR NUMBER is INTEGER range. 1901. ...2099; 
subtype MONTH NUMBER Is INTEGER range 1 .. 12; 

subtype DAY NUMBER Is INTEGER range 1 .. 31; 

subtype DAY_DURATION Is DURATION range 0.0 .. 86_ 400.0; 


function CLOCK return TIME; 


function YEAR (DATE : TIME) return YEAR_NUMBER; 
function MONTH (DATE : TIME) return MONTH_NUMBER; 
function DAY ATE : TIME) return DAY_NUMBER; 
function SECONDS (DATE : TIME) return DAY_DURATION; 


procedure SPLIT (DATE In TIME; 
YEAR : out YEAR_NUMBER; 
MONTH : out MONTH_NUMBER; 


DAY : out DAY_NUMBER; 
SECONDS : out DAY_DURATION); 


function 
TIME_OF( YEAR : YEAR_NUMBER; 
MONTH-~ : MONTH_NUMBER; 
DAY : DAY_NUMBER; 


SECONDS : DAY_DURATION := 0.0) return TIME; 


function "+" (LEFT : TIME; RIGHT : DURATION) return TIME; 
function "+" (LEFT : DURATION; RIGHT : TIME) return TIME; 
function "-" (LEFT :; TIME; RIGHT : DURATION) return TIME; 
function "-" (LEFT : TIME; RIGHT : TIME) return DURATION; 
~ also functions for "<", “<=",">",">=" 
TIME_ERROR : exception; - raised by TIME_OF, "+" and "-" 
private 
-- Implementation-dependent 
end CALENDAR; 
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TERMINATE ALTERNATIVE 


+ CONSTITUTES AN ‘OFFER’ TO TERMINATE 
* CONDITIONS FOR TERMINATION 


-- Task master is completed 

-- All dependent tasks (of master) are 
terminated or ready to terminate 

-- No calling tasks in queue 

-- i.e., If no task can ever again call this task 


loop 
select 


accept DEPOSIT (ID : INTEGER; AMT : FLOAT) do 
end DEPOSIT; 
or” 


end select; 
end loop; 
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TIMED ENTRY CALL 
ABORT STATEMENT 


+ CALLING TASK GETS INTO AN ENTRY 
QUEUE FOR A SPECIFIED MAXIMUM 


+ A TASK CAN ABORT ANY TASK WITHIN ITS PERIOD OF TIME. 
VISIBILITY (INCLUDING ITSELF). 
+ CALLING TASK 'BALKS' THE QUEUE IF NOT 


* RESULT IS UNCONDITIONAL TERMINATION. SERVED WITHIN THAT AMOUNT OF TIME. 
* ALL DEPENDENT TASKS OF THE ABORTED 
TASK ARE ALSO ABORTED. select 
abort TELLER; TELLER.DEPOSIT (ID => 8064, AMT =>100.00); 
or 
* OR, TO GIVE A TASK ITS LAST WISHES: 
delay 30.0*MINUTES; 
DO_SOMETHING_ELSE; 
TELLER.SHUTDOWN; LER 
delay 30.0; Te end select; 
abort TELLER; 
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CONDITIONAL ENTRY CALL 
¢ ATTEMPTS IMMEDIATE RENDEZVOUS ENTRY CALLS CANBE USED TO OA 


» ENTRY QUEUE IS EMPTY ENTRIES WHICH ARE GUARDED 


. ecm TASK IS ALREADY AT THE RENDEZVOUS 


* BEHAVES LIKE A TIMED ENTRY CALL WITH 
DELAY OF 0.0 solect 
ES 
else 
null; 
end select; 


select 
TELLER.WITHDRAW (ID => 8064, AMT => 1000.00); 
else T 
DO_SOMETHING_ELSE; 


end select; 


when <cond> => 
accept E 


end. E; 
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APPLICATIONS FOR TASKS 


* CONCURRENT OPERATIONS 

* MESSAGE ROUTING 

* SHARED RESOURCE MANAGEMENT 
+ INTERRUPT HANDLING 
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task body PARTIAL le 


PRODUCT : INTEGER := 0; 
ROW_PTR : PTR; 
COL_PTR : PTR; 


begin 
acoept SEND (ROW, COL : ROW_OR_COL) do 
RO 


W_PTR := new ROW OR_COL'(ROW); 
COL_PTR := new ROW_OR_COL'(COL); 
end SEND; 


for J In ROW_PTR.all"RANGE 
loop 
PRODUCT := PRODUCT + 


ROW_PTR(J) * COL_PTR(J); 


end foop; 


accept RECEIVE (RESULT : out INTEGER) do 
RESULT := PRODUCT; 
end RECEIVE; 


end PARTIAL; 
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MATRIX MULTIPLICATION 


type ROW_OR_COL Is ee (INTEGER range <>) of INTEGER; 
type PTR Is access ROW_OR_COL; 


task type PARTIAL Is 
entry SEND (ROW, COL : ROW_OR_COL); 
entry RECEIVE (RESULT : out INTEGER); 
end PARTIAL; 


MAIN 


ES) BSES ES 


begin 

-- send row and col 

5 receive partial product 
en 
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Procedure MAIN Is 


COLS : constant := 10; 
ROWS : constant := 10; 
type MATRIX Is array (1 .. ROWS) of 
ROW_OR_COL (1.. COLS); 


MAT 3 MATRIX; 
VECTOR : ROW OR | COL (1 .. COLS); 
FINAL : ROW_OR_COL 1. « ROWS); 


begin 
‘dectare 
WORKER : array (1 .. ROWS) of PARTIAL; — tasks 
begin 
for J in 1... ROWS 


P 
WORKER(J).: BENUIHOW => MAT(J), 
OL => VECTOR); 


end loop; 


for J In 1.. ROWS 


p 
WORKER(J).RECEIVE (FINAL(J)); 
end loop; 


end; = block 


end MAIN; 
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MESSAGE ROUTING 


TO SEND A MESSAGE FROM TASK A TO TASK B 
A B 


[> oa 
[pl Pf] 


A 


[Feet] 
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A SYNCHRONIZING BUFFER 


task SYNCHRONIZER Is 
entry PUT (ITEM : In SOME_TYPE); 
entry GET (ITEM : out SOME_TYPE); 
end SYNCHRONIZER; 


task body SYNCHRONIZER Is 
SPOT : SOME_TYPE; 
begin 
loop 
accept PUT (ITEM : In SOME_TYPE) do 
SPOT := ITEM; 
end PUT; 
accept GET (ITEM : out SOME_TYPE) do 


ITEM := SPOT; 
end GET; 


end loop; 
end SYNCHRONIZER; 


SYNCHRONIZER 


Lf Se 


sic ei 


5 , Sree 


Software Engineering with Ada 278 


PRIORITY MESSAGES 


type PRIORITY Is (LOW, MEDIUM, HIGH); 


task SWITCH Is SWITCH 

entry SEND (PRIORITY) 

(M: In STRING); [ SeND(Low)_| 
end SWITCH; 
, [SENO(MEDIUM) | 
[_senocHiah) | 

task body SWITCH Is 
begin 

loop 

select 


accept SEND(HIGH) (M : In STRING) do... end SEND; 
ir 


when SEND{HIGH)'COUNT = 0 => 


accept SEND(MEDIUM) (M : In STRING) do ... end SEND; 


or 


when SEND(HIGH)'COUNT = 0 and 


SEND(MEDIUM)'COUNT = 0 => 
accept SEND (LOW)(M: In STRING) do... end SEND; 


end select; 
end loop; 
end SWITCH; 
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PUMPING TASK 


task PUMP; 


task SENDER is 
entry READ (ITEM : out SOME_TYPE); 
end SENDER; 


task RECEIVER Is 


entry WRITE (ITEM : In SOME_TYPE); 
end RECEIVER; a 


task body PUMP Is 
THE_ITEM : SOME_TYPE; 
begin 
loop 
SENDER.READ (THE_ITEM); 
RECEIVER.WRITE (THE_ITEM); 
end loop; 
end PUMP; 


task body SENDER ia separate; 
task body RECEIVER Is separate; 


SENDER PUMP RECEIVER 


Loaf Pgh 7 
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CONTROLLING RESOURCES 


SEVERAL CONCERNS ARE PRESENT WHEN DEALING 
WITH PARALLELISM THAT ARE NOT PRESENT WHEN 
DEALING IN A PURELY SEQUENTIAL MODE 


IT IS IMPORTANT TO BE ABLE TO ASSURE THAT 

A VALUE IS NOT BEING CHANGED BY ONE USER AT 
THE PRECISE MOMENT THAT IT IS BEING REFERENCED 
BY ANOTHER USER 


+ Ada PROVIDES A PRAGMA ‘SHARED’ WHICH CAN 
HELP 


INDEX : Integer; 
pragma SHARED(INDEX); 


¢« ENFORCES MUTUALLY EXCLUSIVE ACCESS 
+ AVAILABLE FOR SCALAR AND ACCESS TYPES ONLY 
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ENCAPSULATING A DATA ITEM 


task PROTECTED Is 
entry SET (OBJ : In SOME_TYPE); 
entry GET (OBJ : out SOME_TYPE); 
end PROTECTED; 


task body PROTECTED uy 
LOCAL : SOME_TYPE; 
— | a | 


accept SET (OBJ : in SOME_TYPE) do 
LOCAL := OBJ; 


end SET; 


loop 
select 


accept SET (OBJ : In SOME_TYPE) do 
LOCAL := OBJ; 
end SET; 


accept GET (OBJ : out Integer) do 
OBJ := LOCAL; 
end GET; 


end select; 
end loop; 
end PROTECTED; 


Software Engineering with Ada 282 


SEMAPHORES 


task SEMAPHORE is 


entry SEIZE; 
entry RELEASE; 


end SEMAPHORE; 


task body SEMAPHORE is 


begin 
loop 


accept SEIZE; 
accept RELEASE; 


end loop; 
end SEMAPHORE; 
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HARDWARE INTERRUPTS 


+ FOR ARCHITECTURES THAT ‘JUMP’ TO A CERTAIN 
HARDWARE ADDRESS UPON RECEIPT OF AN INTERRUPT 


+ A TASK ENTRY IS ASSOCIATED WITH THE ADDRESS 
+ PRIORITY IS HIGHER THAN ANY USER-DEFINED 


taek INTERRUPT_HANDLER le 
entry DONE; 
tor DONE use at 164404; 
end INTERRUPT_HANDLER; 


task body INTERRUPT_HANDLER Is 
begin 
loop 
accept DONE do 
end DONE; 
end loop; 


end INTERRUPT_HANDLER; 
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EVENT DRIVEN SYSTEMS W/BACKGROUND 


* Acyclic executive might deal with several levels of 
processing 


— Event driven processing (high priority, perhape 
interrupt handling) 


= Periodic (cyclic) processing 
- Background processing (low priority) 


EXECUTIVE 


ei 7 


BACKGROUND PERIODIC 


7 
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EXCEPTIONS 


« WHEN AN EXCEPTION !S RAISED, EXECUTION IS 
ABANDONED AND AN EXCEPTION HANDLER IS SOUGHT 


* PREDEFINED EXCEPTIONS 


-- CONSTRAINT_ERROR 
raised when a range, Index, or discriminant 
constraint Is violated 


-- NUMERIC_ERROR 
ralsed when a numeric operation ylekis a result 
that cannot be represented 


-- PROGRAM_ERROR 
ralsed when all alternatives of a select statement 
having no else part are closed or H an erroneous 
condition Is detected 


-- STORAGE_ERROR 
raised when insufficient storage remains for 
a given collection of designated objects 


-- TASKING_ERROR 


raleed by trying to communicate with a 
dead tas! 
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procedure EXECUTIVE Is 


task TASK_1 Is 
pragma PRIORITY (10); 
entry EVENT; 

end TASK_1; 


task TASK_2 Is 

entry EVENT; 

for EVENT use at 1641108; 
end TASK_2; 


task BACKGROUND Is 
pragma PRIORITY (0); 
end BACKGROUND; 


task PERIODIC Is 
pragma PRIORITY (5); 
entry TICK; 
end PERIODIC; 


task body PERIODIC Is 


~ one tick per cycle 


begin 
loop 
accept TICK; 
... ~ process a frame 
end loop; 
end PERIODIC; 


- bodies (or stubs) of other tasks go here 
end EXECUTIVE; 
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USER-DEFINED EXCEPTIONS 


+ BASIC DECLARATIVE ITEMS 
* CAN ONLY BE RAISED EXPLICITLY 
UNDER_FLOW, OVER_TEMP : exception; 


raise UNDER_FLOW; 
raise NUMERIC_ERROR; 


ralse; 
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SUPPRESSION OF CHECKS 


+ RUNTIME CHECKS IMPOSE A CERTAIN OVERHEAD 
* CHECKS CAN BE TURNED OFF 


+ EFFECTS OF TURNING OFF CHECKS CAN BE LIMITED 
TO CERTAIN OBJECTS AND CERTAIN UNITS 


* CHECKS THAT RAISE PREDEFINED EXCEPTIONS 
— access_check, discriminant_check, Index_check, 
— length_check, range_check, division_check, 
— overfiow_check, elaboratlon_check, storage_check 
* SETTING THE CHECK-SUPPRESSION 


pragma SUPPRESS (Index_check, ON => MY_INDEX); 
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FRAMES OF REFERENCE 


SUBPROGRAM BODY BLOCK STATEMENT 


TASK BODY PACKAGE BODY 
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EXCEPTION HANDLERS 


* CAN APPEAR AT THE END OF A BLOCK STATEMENT, 
SUBPROGRAM, PACKAGE OR TASK 


* TAKE THE FORM OF A CASE STATEMENT 
* CAN CONTAIN AN ‘OTHERS’ HANDLER 


* EXCEPTIONS NOT HANDLED IN THE ‘NEAREST 
HANDLER ARE PROPAGATED 
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EXCEPTIONS RAISED IN BLOCKS 


EXCEPTION HANDLER EXISTS 


-- Exception Is handled and control passes 
= to the next sequential statement following the 
-- block statement 


NO EXCEPTION HANDLER EXISTS 


- Exception Is propagated statically (ihe same error 
- ls ralsed at the next sequential statement following 
~ the block statement) 


EXCEPTION IS RAISED IN DECLARATIVE PART 


-- Exception is Immediately raised at the next 
— sequential statement following the block statement 
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EXCEPTIONS RAISED IN SUBPROGRAMS 
EXCEPTION HANDLER EXISTS 


- Exception Is handled and contro! passes to the 
— point of call 


NO EXCEPTION HANDLER EXISTS 
~ Exception Is propagated dynamically (the same 


— error Is raised at the point of call) 
EXCEPTIONS RAISED IN DECLARATIVE PART 


— Exception Is Immediately ralsed at the point 
— of call of the subprogram 
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EXCEPTIONS RAISED IN TASKS 


EXCEPTION HANDLER EXISTS 


— Exception Is handied and the task Is complete 


NQ EXCEPTION HANDLER EXISTS 


— Task Is complete 


EXCEPTION IS RAISED IN DECLARATIVE PART 


— Task is complete and the tasking_error exception 
— Is raised at the point of activation of task 


+ EXCEPTIONS RAISED DURING TASK COMMUNICATION 


- Atasking_error Is raised In the calling task If 
— called task Is completed before rendezvous takes 
- place 


-- When an exception Is raised in the called task, 
— the same error Is propagated to the calling task 


-- When an exception Is raised In the calling task, 
-- the same error is nol propagated to the called task 
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| EXCEPTIONS RAISED IN PACKAGES | 


+ PACKAGE IS A DECLARATIVE ITEM (NESTED) 


EXCEPTION HANDLER EXISTS 


~ Exception Is handled and elaboration of the package 
-- body Is completed 


NO EXCEPTION HANDLER EXISTS: 


~ The same exception Is raised following the 
-- declarative Item 


EXCEPTION IS RAISED IN DECLARATIVE PART 


~ The same exception Is ralsed following the 
-- declarative item 
* PACKAGE IS A COMPILATION UNIT 


EXCEPTION HANDLER EXISTS 
~ Exception Is handled and elaboration Is complete 
ALL OTHER CASES 


~ Execution of main program Is abandoned 
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+ AN ANONYMOUS RAISE STATEMENT ALLOWS 
PARTIAL HANDLING WITH MORE COMPLETE HANDLING 
ACCOMPLISHED AT AN OUTER LEVEL 


exception 
when numeric_error => 
<sequence_of_stalements> 
ralse; +— same exception Is propagated 
end; 


+ YOU CAN PROPAGATE AN EXCEPTION BEYOND ITS SCOPE 
begin 
‘deciare 
LOCAL_EXCEPTION : exception; 
begin 


“raise LOCAL_EXCEPTION; 
‘end; ~no exception handler 


exception 

when others => 
a <sequence_of_statements> 
end; 
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REPRESENTATION SPECIFICATIONS 


+ ALLOW THE USER TO GET DOWN TO THE BIT LEVEL 
OF THE UNDERLYING ARCHITECTURE 


* PROVIDE MACHINE-DEPENDENT CAPABILITY 
+ ARE NOT PART OF THE ACVC 
* THE USER CAN SPECIFY: 

- SZE 

— RECORD TYPE REPRESENTATION 

~- ENUMERATION TYPE REPRESENTATION 

- ADDRESS SPECIFICATION 


Software Engineering with Ada 299 


RECORD TYPE REPRESENTATION 


* SPECIFIES ORDER, POSITION, SIZE OF COMPONENTS 
+ SPECIFIES MULTIPLE UNIT ALLIGNMENT 


type 1O_PORT Is 
d 


DATA : INTEGER range 0 .. 255; 
READY __ : BOOLEAN; 
ENABLED : BOOLEAN; 

end record; 


for |O_PORT use 
record atmod 2; -- double unit boundary 
DATA at Orange 0 .. 7; 
READY at 1 range 3.. ed 
ENABLED at1range7.. 
end record; 


0123456701234567 


DATA READY ENABLED 


‘ 
f 
f 
i, 
ii 
\ 
I 
| 
| 
' 
f 
| 
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SIZE REPRESENTATION 


¢ TO DICTATE SIZE OF OBJECTS OF A TYPE 
type MY_RANGE is range -100 .. 100; 
for MY_RANGE'SIZE use 8; - bits 
¢ TO DICTATE SIZE OF A COLLECTION OF 
DESIGNATED OBJECTS 
BYTES : constant :=8; -- bits 


type SOME_TYPE is . 
type PTR Is access SOME _ TYPE; 


for PTR'STORAGE_SIZE use 1000*BYTES; 
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ENUMERATION TYPE REPRESENTATION 


+ ALLOWS THE USER TO DICTATE THE UNDERLYING 
REPRESENTATION OF LITERALS OF AN ENUMERATED 
TYPE 


. * NUMERK ORDER MUST NOT VIOLATE PREDEFINED 
ORDER 


* SUCC, PRED, POS ARE DEFINED EVEN WHEN GAPS 
EXIST IN UNDERLYING REPRESENTATION 


type RESPONSE Is (UP, DOWN, LEFT, RIGHT); 
for RESPONSE'SIZE use 4; 


for RESPONSE use(UP — => 200014, 
DOWN => 2#0010#, 
LEFT => 2#0100#, 
RIGHT => 2#1000#); 
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ADDRESS REPRESENTATION 


+ ALLOWS THE USER TO DICTATE THE ACTUAL 
ADDRESS OF OBJECTS, SUBPROGRAMS AND 
TASKS 


COUNTER : INTEGER; 
for COUNTER use at 16#100#; 


procedure EMERGENCY; 
for EMERGENCY use at 1 6#FF4E#; 


task MONITOR Is 

entry FAILURE; 

for FAILURE use at 8#7776%; 
end MONITOR; 
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CAVEAT EMPTOR 
generic 


type SOURCE is limited private; 
type TARGET is limited private; 


function UNCHECKED_CONVERSION(S : SOURCE) 
retum TARGET; 


* Returns the al edad parameter value 
as a value of the target type. 


* Usually generates no additional code 
+ It is the programmers responsibility to ensure 


that conversion maintains the properties of the 
target type 
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CAVEAT EMPTOR 
generic 


type OBJECT Is Inlted private: 
NAME |s access ; ; 
PR Lielis UNCHECKED_DEALLOCATION(X : In out NAME); 


type MY_TYPES... 
type POINTER Is access MY_TYPE; 


jure FREE Is new UNCHECKED_DEALLOCATION 
iat (OBJECT => MY_TYPE, 
NAME => POINTER); 
VALVE, FRAMUS : POINTER; 


VALVE := new MY_TYPE; 
FRAMUS == VALVE; 


ee VALVE FRAMUS 
FREE (VALVE); 
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OTHER LANGUAGES 


+ ASUBPROGRAM WRITTEN IN ANOTHER LANGUAGE 
CAN BE CALLED FROM AN ADA PROGRAM 


+ ALL COMMUNICATION MUST BE ACHIEVED VIA 
PARAMETERS AND FUNCTION RESULTS 


+ APRAGMA MUST BE GIVEN FOR EACH SUBPROGRAM 
+ SUBPROGRAM BODY IS NOT ALLOWED 
* CAPABILITY NEED NOT BE PROVIDED BY AN 
IMPLEMENTATION 
package FORT_LIBIS 


function SORT (X : FLOAT) retum FLOAT; 
function EXP (X : FLOAT) retum FLOAT; 


Private 


pragma INTERFACE (FORTRAN, SQRT): 
pragma INTERFACE (FORTRAN, EXP); 


end FORT_LIB; 
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AdaLARM Control Panel de 
« NEUTRAL 


x Oe 


ENABLING: When the Enable Alarm button Js pressed, the Indicator 
Ilght goes on and the sensors are activated after approximately 

1 minute. The key Indicator must be at ‘neutral’. The enable 

button has no affect If the light Is not ‘off. 


« DISABLING: When the Disable Alarm button Is pressed, the Indicator 
light goes off and the sensors are Immediately deactivated. The 
disable button has no affect If the light Is not ‘on’ (steady). 


+ ARMING: If the alarm Is enabled and a sensor detects an intruder, 
the alarm becomes armed (the indicator IIght begins to blink). 
If the alarm Is not disarmed (see below) within 1 minute, the 
klaxon is sounded and the security office is automatically dialed. 


DISARMING: The alarm Is disarmed by Inserting the key and turning 
it clockwise (to ‘disarm’). When this Is done, the light and the klaxon 
are turned off but the owner must call the security office personally. 
The key must be turned counterclockwise (to ‘neutral’) before the 
alarm can again be enabled. ! 


~ Con he. ment ? 


\ ly7 QW cs 
Tey ee 
~ doprr - | 
— noude 
AS 
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AdaLARM 


INTERRUPT_HANOLER 


TURN_BLUNK 


TURN_OFF 


KLAXON 


TURN_OFF 
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AdaLARM Project 


Design an implementation for the AdaLARM system subject 
to the following conditions: 


* The AdaLARM system uses an a fe processor with 
certain devices memory mapped. All hardware interrupts 
cause a vector to octal location 40. A status word is located 
at octal location 42 and gives additional information about 
the interrupts: 


INTERRUPT STATUS WORD 
Enable button 00000001 
Disable button 00000010 
Key to ‘disarm’ 00000100 
Key to ‘neutral’ 00010000 
Sensor trigger 00001000 


* The autodial to the security office takes place automatically 
when the klaxon is sounded. 


¢ The light is mapped to octal location 50 and has the 
following representation: 


LIGHT STATUS REPRESENTATION 
Light is off 00000000 
Light is on paeec) 11411111 
Light is blinking 00001111 


* The Klaxon is mapped to octal location 60 and has the 
following representation: 


KLAXON STATUS = REPRESENTATION 


Klaxon Is sounding 11111111 
Klaxon is silent 10000000 
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procedure AdaLARM is 


task INTERRUPT_HANDLER is 
pa! TRIGGER; 

for TRIGGER use at 8#40#; 
end INTERRUPT_HANDLER; 


task ALARM is 
entry NEUTRAL; 
entry INTRUDER; 
entry DISARM; 
entry ENABLE; 
entry DISABLE; 
end ALARM; 


package KLAXON is 
procedure TURN_ON; 
‘ocedure TURN_OFF; 
end KLAXON; 


package LIGHT is 
procedure TURN_ON; 
procedure TURN_BLINK; 
procedure TURN_OFF; 
function IS_ON return BOOLEAN; 
function IS_OFF return BOOLEAN; 


end LIGHT; ; 
task body INTERRUPT_HANDLER is separate; 
task body ALARM is separate; 
package body KLAXON Is separate; 
package body LIGHT Is separate; 
begin 
null; __-- lat the tasks do all the work 


end AdaLARM; 
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separate (AdaLARM 
package body LIGHT is 


type LIGHT_: — is (OFF, BLINK, ON); 
for LIGHT_STATUS'SIZE use 8; -- bits 


for LIGHT_STATUS use (OFF — => 2#00000000#, 
BLINK => 2#00001111#, 
=> 2#11111111#); 


BULB : LIGHT_STATUS := OFF; 
for BULB use at 8#50#; 


rocedure TURN_ON is 


in 
= BULB := ON; 
end; 


rocedure TURN_BLINK is 
agin 
BULB := BLINK; 
end; 


ee TURN_OFF is 


BULB := OFF; 
end; 


Pration IS_ON retum BOOLEAN is 
agin 

z retum BULB = ON; 

end; 


function IS_OFF return BOOLEAN is 
begin 

return BULB = OFF; 
end; 


end LIGHT; 
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separate (AdaLARM) 
task body INTERRUPT_HANDLER is 


type STATUS is ( ENABLE, DISABLE, KEY_DISARM, 
SENSOR, KEY NEUTRAL); 


for STATUS'SIZE use 8; 
for STATUS use ( plete => 2#00000001#, 
SABLE => 2#00000010#, 
KEY DISARM => 2#00000100#, 
SENSOR => 2#00001000#, 


KEY_NEUTRAL => 2#00010000#); 


STATUS_WORD : STATUS; 
for STATUS_WORD use at 8#42#: 


WORD : STATUS; __ -- Saves the STATUS_WORD to 
-- avoid the ‘simultaneous’ 


-- interrupt problem. 
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separate (AdaLARM) 
package body KLAXON is 


task pee i OFFICE is 
entry CA 
end; 


type KLAXON_STATUS is (OFF, ON); 
for KLAXON_STATUS'SIZE use 8; 


ON_STATUS use (OFF => 2#00000000#, 
eel (ON => 24111111118); 


HORN : KLAXON_STATUS := OFF; 
for HORN use at 8#60#; 


task body SECURITY_OFFICE Is separate; 


rocedure TURN_ON is 
egin 
HORN := ON; 
SECURITY_OFFICE.CALL; 
end; 
rocedure TURN_OFF is 
agin 
HORN := OFF; 
end; 


end KLAXON; 
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begin -- INTERRUPT_HANDLER; 
nee 


t TRIGGER do 
ORD := STATUS_WORD; 
end TRIGGER; 


-- Perhaps an exception handler in case of 
-- multiple interrupts 


case WORD is 
when ENABLE => select 
ALARM.ENABLE; 
else 
null; 
end select; 
when DISABLE => select 
ALARM.DISABLE 
else 
null; 
end select; 
when KEY_DISARM => ALARM.DISARM; 
when KEY_NEUTRAL => ALARM.NEUTRAL 
when SENSOR => select 
ALARM.INTRUDER; 
else 
null; 
end case; end select; 
end loop; 


end INTERRUPT_HANDLER;: 
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separate (AdaLARM) 
task body ALARM Is 


type KEY_TYPE is (NEUTRAL_STATE, 
DISARM_STATE); 


KEY : KEY_TYPE := NEUTRAL_STATE; 
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or 
when LIGHT.IS_ON => 


i accapt INTRUDER; 
LIGHT.TURN_BLINK; 


select 
accept DISARM; 


: - walt for deactivation 
LIGHT. TURN_OFF; 


-- Klaxan Is not sounding 


begin KEY := DISARM_STATE; 
loop or 
delay 60.0 ~ allow time to Insert key 
select KI ON.TURN_ON; 
accept NEUTRAL; end select; 
LIGHT.TURN_OFF; 
KEY := NEUTRAL_STATE; or 
or 
e accept DISARM; 
Q when KEY = NEUEN, Sa OFF a KLAXON TURN OFF; 
LE: T. | OFF; ~ Klaxan Is sounding or k 
acce pt ENABLE: e KEY := DISARM_STATE; — simpy turned to disarm by 
(delay 60.0; <.h) st S — mistake 
ipecs ieee Os OO 5 ehh 
or ey ns end select; 
B when LIGHT.IS_ON => cca es : 
7 accept DISABLE; Ov Solon CAD) end loop; 
LIGHT.TURN_OFF; Nae end ALARM; 


- VB og oloct 
y 
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PROGRAM STRUCTURE 


* A program is a collection of one or more compilation 
units submitted to a compiler in one or more compilations 


* The compilation units of a program are said to belong 
to a program library 


* Acompilation unit defines either a library unit or a 
secondary unit 


<compilktion> ::= {<compilation_unit>} 

<compilation_unit> ::= ; 
<context_clause><library_unit> | _ 
<context_clause><secondary_unit> 


<context_clause> ::= 
{with_clause {use_clause}} 


Software Engineering with Ada 317 


* A body stub is only allowed as the body of a program unit 
(a subprogram, package, task or generic unit) if the body 
stub occurs immediately within the declarative part of 
another compilation unit. 


Visibility within the subunit is the visibllity that would be 
obtained at the place of the corresponding body stub 
(within the parent unit) if the with clauses and use clauses 
of the subunit were appended to the context clause of the 
parent unit. 


* The simple names of all subunits that have the same 
ancestor library unit must be distinct identifiers. 


« An operator symbol cannot be the designator of a 
subunit. 
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LIBRARY UNITS 


+ SUBPROGRAM DECLARATION (SPECIFICATION) 
PACKAGE DECLARATION (SPECIFICATION) 
GENERIC DECLARATION (SPECIFICATION) 


SUBPROGRAM BODY (only if there is no distinct 
subprogram declaration as a library unit) 


GENERIC INSTANTIATION 


SECONDARY UNITS 


LIBRARY UNIT BODY 


-- SUBPROGRAM BODY 
-- PACKAGE BODY 


* SUBUNIT 


NOTE: A ‘WITH’ CLAUSE ALWAYS REFERS TO A LIBRARY 
UNIT, NEVER TO A SECONDARY UNIT 


. 
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ORDER OF COMPILATION 


1. Acompilation unit must be (re)compiled after all 
library units named by its context clause. 


2. A secondary unit that is a subprogram or 
package body must be (re)compiled after the 
corresponding library unit. 


3. Any subunit of a parent compilation unit must 
be (re)compiled after the parent compilation unit 


AdaVENTURE 1 


EANTASY SIMULATION GAMES 


In games like ADVENTURE and ZORK (DUNGEON) the adventurer 
enters commands which are subsequently executed. If the player 
enters words which are not part of the vocabulary of the game, 
an error message will be generated and the player will ba able to 
attempt another command. If the command Is valld (contains only 
words from the vocabulary In thelr expected grammatical order) 
but the command has no valid meaning (GO KNIFE), then a different 
error Is generated and the player again gets another chance. Commands 
In such games move the player from placa to place, allow the Player to 
pick up and drop Items, allow the player to Inventory his current 
holding of Items etc. 


The game we will Implement has a limited map (11 locations) and 
a vary limited vocabulary (GO, TAKE, DROP, OPEN, LIGHT, UNLOCK, 
READ, SAY, INVENTORY, QUIT, NORTH, EAST, WEST, SOUTH, 
LAMP, KEY, DOOR, ADA, GOLD). A valid command Is of the form 
VERB- NOUN such as OPEN DOOR, GO NORTH etc. 


The game must keep track of such state Information as Player's 
location and current Inventory as well as the current Inventory 
of each location. The goal Is to rescue Ada from the locked cell, find 
the gold and silver, and escape to the cave entrance. There Is a door 
which separates the dungeon from the call. Once unlocked, It 
remains unlocked, once open, It remalns open. 


There Is a secret passage In the Glant's room which opens Into the 


maze only if the player has uttered the magic word (“abracADAbra’) 
while In the giant's room. 
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The main pesrem will GET COMMANDs from the player 
and will EXECUTE these COMMANDs. This process wil 
continue until either the PLAYER QUITS or the PLAYER 
WINS, COMMANDs will be represented as VERB-NOUN 
pairs from some VOCABULARY. 


COMMAND_INFO 


PLAY_AdaVENTURE 


USER_QUITS 


DIRECTIONS 
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DUNGEON DOOR 
Location Message 
ENTRANCE “You are at the entrance of a cave” 
CAVE “You are In a large cave" 
GOLD_ROOM “You have entered the gold room” 
GIANT_ROOM “You are In the giant's room" 
CHAMBER “You've entered a dusty chamber, a sign says 
‘abracADAbra™ 
all mazes "You are In a maze of twisty passages all allke” 
DUNGEON “You have found the dungeon” 
CELL “You are in a damp call” 
AdaVENTURE 4 
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package VOCABULARY is 
type WORDS is ( NORTH, EAST, WEST, SOUTH, 
GOLD, SILVER, NOTE, LAMP, KEY, 
Ada, MAGIC_WORD, DOOR, GO, 
TAKE, LIGHT, DROP, READ, SAY, 
OPEN, UNLOCK, QUIT, INVENTORY); 
subtype NOUNS _is WORDS range NORTH .. DOOR; 


subtype VERBS is WORDS range GO .. INVENTORY; 


subtype DIRECTIONS is NOUNS range NORTH .. SOUTH: 
-+ Primarily used with the GO verb. 


subtype THINGS —_ is NOUNS range GOLD .. Ada; 


~- These are THINGS that can be carried by the player 
+- and that can be found in various locations. 


end VOCABULARY; 
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Leen EEE 


with VOCABULARY; 
package COMMAND_ INFO is 


type COMMAND is private; 
procedure GET (CG : out COMMAND); 
-- This procedure interacts with the player to get a 
-- legal command. If the command Is not legal, the 
-- GET routine will continue to interrogate the player 
-- until a legal command is finally entered. 
procedure EXECUTE (C : in COMMAND); 
-- This procedure performs the action indicated 
-- by the player. Silly (legal but invalid) commands such 
-- as 'GO KEY ' are treated with the respect they deserve. 
- Valid commands are carried out. 
function USER_QUITS (C : COMMAND) retum boolean; 


function USER_WINS retum boolean; 
private 


type COMMAND is 
record 


VERB : VOCABULARY.VERBS; 
NOUN : VOCABULARY.NOUNS; 
end record; 
end COMMAND_INFO; 
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package body COMMAND_INFO is 


procedure GET (C : out COMMAND) is separate; 
function USER_QUITS (C : COMMAND) 

retum BOOLEAN is separate; 
function USER_WINS return BOOLEAN __is separate; 


procedure EXECUTE (C :in COMMAND) is separate; 
end COMMAND_INFO; ! 


VOCABULARY 


COMMAND_INFO 
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AdaVENTURE 


with COMMAND_INFO; use COMMAND_INFO; 
procedure PLAY_AdaVENTU RE is 


THE_COMMAND : COMMAND_INFO.COMMAND; 
begin 
loop 
GET (THE_COMMAND); 
EXECUTE (THE_COMMAND); 


exit when USER_QUITS (THE_COMMAND) 
or USER_WINS; 


end loop; 
-- some final message could be printed here. 


end PLAY_AdaVENTURE; 
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with TEXT_IO; 
separate (COMMAND_INFO) 
procedure EXECUTE (C : In COMMAND) is 


~ 
procedure GO_RTN (NOUN : In VOCABULARY.NOUNS) 


+> a subunit 


is separate; 

procedure DROP_RTN (NOUN : In VOCABULARY.NOUNS) 
Is separate; 

procedure TAKE_ATN (NOUN : in VOCABULARY.NOUNS) 
Is separate; 

procedure OPEN_RTN (NOUN : In VOCABULARY.NOUNS) 
is separate; 

procedure UNLOCK_RTN (NOUN : in VOCABULARY.NOUNS) 
Is separate; 

procedure READ_RTN (NOUN : In VOCABULARY.NOUNS) 


Is separate; 

procedure SAY_RTN (NOUN : In VOCABULARY.NOUNS) 
Is separate; 

procedure LIGHT_RTN (NOUN : in VOCABULARY.NOUNS) 
is separate; 

procedure INVENTORY_RTN Is separate; 


use VOCABULARY; -- for direct visibility 


begin 

case C.VERB Ie 
when GO => GO_RTN (NOUN => C.NOUN); 
when TAKE => TAKE_RTN (NOUN => CNOUN}, 
when DROP => DROP_RTN (NOUN => C.NOUN): 
when OPEN => OPEN_RTN NOUN => C.NOUN 
when UNLOCK => UNLOCK _RTN (NOUN => C.NOUN’ Fi 
when LIGHT n> LIGHT_RTN (NOUN a> C.NOUN); 
when INVENTORY => INVENTORY_RTN; 
when Ee z> SAY_RTN (NOUN => C.NOUN); 
when => READ_RITN = P 
when OTHERS => null; SRN ee Se 

end case; 


end EXECUTE; 
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Ada as Pseudo Code 


procedure GO_RTN (NOUN : in VOCABULARY.NOUNS) Is 


begin 
if NOUN Is a valid direction (N, E, W, S) then 
if the exit Is blocked then 
PRINT (Sorry, you can't go that way”); 
else 
Move player in direction indicated by NOUN. 
Print the appropriate welcoming message. 
List the contents of the new room. 
end if; 
else 
PRINT (‘That's really bizarre!!"); 
end if; 
end GO_RTN; 
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PLAYER 


LIST_INVENTORY 


with VOCABULARY; 
package PLAYER Is 


procedure ADD (OBJECT : In VOCABULARY.THINGS); 
procedure REMOVE (OBJECT : in VOCABULARY.THINGS); 


function HAS (OBJECT : VOCABULARY.THINGS) 
retum BOOLEAN; 


procedure LIST_INVENTORY; 
end PLAYER; 
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DUNGEON_DOOoR 


package DUNGEON_DOOR is 
procedure OPEN; 
procedure UNLOCK; 
function IS_OPEN return BOOLEAN; 
function IS_LOCKED return BOOLEAN; 
end DUNGEON_DOOR; 
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MAP 


LOCATIONS 
PLAYER_LOCATION 


EXIT_IS_BLOCKED 


MOVE_PLAYER 
OPEN_SECRET_DOOR 


DISPLAY_MSG 


MAP_ERROR 


cr 


Initialize THE_MAP and print 
beginning messages 
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with VOCABULARY; 
package MAP Is 


type LOCATIONS is 
(ENTRANCE, CAVE, GOLD_ROOM, GIANT_ROOM, 
CHAMBER, MAZE_1, MAZE_2, MAZE_3, MAZE_4, 
DUNGEON, CELL, BLOCKED); 
~ Note: all of the following operations are relative to the 
~ current location of the player. That Information Is kept 
- In the package body as state information. 
function PLAYER_LOCATION return LOCATIONS; 


function EXIT_IS_BLOCKED 
(DIR : VOCABULARY.DIRECTIONS) return BOOLEAN; 


procedure MOVE_PLAYER (DIR : In VOCABULARY.DIRECTIONS); 
Procedure OPEN_SECRET_DOOR; 

procedure DISPLAY_MSG; 

procedure DISPLAY_CONTENTS; 


function OBJECT_IS_PRESENT (OBJECT : VOCABULARY.THINGS) 
return boolean; 


procedure REMOVE OBJECT (OBJECT : In VOCABULARY.THINGS); 


procedure ADD_OBJECT 
MAP_ERROR : exception; 


end MAP; 
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pst icom Le ati e . 
procedure GO_RTN (NOUN : in VOCABULARY.NOUNS) is 
begin 
if NOUN in VOCABULARY.DIRECTIONS then -- N,E,W,S 
if MAP.EXIT_IS_BLOCKED (DIR => NOUN) then 
TEXT_IO.PUT_LINE ("Sorry, you can't go that way"); 
else 


ee ee => NOUN); 


-- Let the ay ‘er know where he is 
MAP.DISPLAY_MSG; 
MAP.DISPLAY_CONTENTS; 
end if; 
else 


TEXT_IO.PUT_LINE (‘That's really bizarre!!"); 
end if; 
end GO_RTN; 


(OBJECT : In VOCABULARY.THINGS); 


AdaVENTL RE 14 
AdgeVENTURE 


separate (COMMAND_INFO) 
EXECUTE 


VARIOUS 
VERB 
ROUTINES 


(SUBUNITS) 


VOCABULARY PLAYER MAP DUNGEON_DOOR 
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a 


package body PLAYER is 


type ITEMS Is array (VOCABULARY.THINGS) of BOOLEAN; 
EMPTY_BAG : constant ITEMS := ITEMS'(others=>FALSE); 


THE_BAG : ITEMS := EMPTY_BAG; 
Procedure ADD (OBJECT : in VOCABULARY.THINGS) Is 
gin 
THE_BAG (OBJECT) := TRUE; 
ind ADD; 


procedure REMOVE (OBJECT : in VOCABULARY.THINGS) Is 
agin 


end REMOVE; 


function HAS (OBJECT : VOCABULARY.THINGS) 
return BOOLEAN Is 
begin 


end HAS; 


Procedure LIST_INVENTORY Is separate; 
end PLAYER; 


AdaVENTURE 17 


with TEXT_IO; 
separate (PLAYER 
procedure LIST_INVENTORY is 
begin 
If THE_BAG = EMPTY_BAG then 
TEXT_IO.PUT_LINE(“You aren't carrying anything"); 
else 
TEXT_IO.PUT_LINE("You are caryicg the following:"); 
for INDEX in VOCABULARY. THIN 
loop 
if THE_BAG (INDEX) then -- patted THING 
TEXT_IO.PUT_LINE to STRING 
(VOCABULARY, THINGS'IMAGE (INDEX)); 
end if; 
end loop; 
end If; 


end LIST_INVENTORY; 
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with DUNGEON_DOOR, TEXT_IO; 
package body MAP is 


type THING_SET Is array (VOCABULARY.THINGS) of BOOLEAN; 
EMPTY_SET : constant THING SET := (others => FALSE); 


type EXITS Is array (VOCABULARY.DIRECTIONS) of LOCATIONS; 


type SCENES Is 
record 


MSG : STRING (1..60); 
CONTENTS : THING SET; 
PASSAGES: EXITS; 
end record; 
subtype PLACES Is LOCATIONS range ENTRANCE .. CELL; 
type MAP_TYPE is array (PLACES) of SCENES; 


State Information follows-: 


THE_MAP 


: MAP_TYPE; 


THE_LOCATION 


: PLACES := ENTRANCE; 
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package body DUNGEON_DOOR is 
type STATUS is (OPENED, LOCKED, UNLOCKED); 
THE_DOOR : STATUS := LOCKED; 
procediea OPEN is 


in 
HE_DOOR := OPENED; 
end; . 


procedure UNLOCK is 


in 
HE_DOOR := UNLOCKED; 
end; 


function IS_OPEN return BOOLEAN is 


in 
retum THE_DOOR = OPENED; 
end; 


function IS_LOCKED return BOOLEAN is 


jegin 
retum THE_DOOR = LOCKED; 
end; 


end DUNGEON_DOOR; 
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THING_SET THE_MAP 
(MAP_TYPE) 
GOLD 
SILVER ENTRANCE Pl EY 
NOTE CAVE ea | | i 
TAME @OLD_ROOM Pl FT Y 
KEY 
ADA GIANT_ROOM el FT Y 
CHAMBER Pe FY 
EES. MAZE_1 a 
NORTH 
east MAZE_2 
WEST MAZE_3 
SOUTH 
MAZE_4 
DUNGEON 
CELL 
SCENES 


Co a 


= 
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————— 


function PLAYER_LOCATION return LOCATIONS Is 
begin 


end PLAYER_LOCATION; 
function EXIT_IS_BLOCKED 
(DIR : VOCABULARY.DIRECTIONS) 
retum BOOLEAN Is 
begin 


end EXiT_IS_BLOCKED; 


proce 


ure 
(DIR : In VOCABULARY.DIRECTIONS) is 
begin 


end MOVE PLAYER; 


procedure OPEN_SECRET_DOOR Is 
begin 


end OPEN_SECRET_DOOR; 


procedure DISPLAY_MSG Is 
begin 


end DISPLAY_MSG; 
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function OBJECT_IS_PRESENT (OBJECT : VOCABULARY.THINGS) 
return BOOLEAN is 
begin 


end OBJECT_IS_PRESENT; 


procedure REMOVE OBJECT (OBJECT : in VOCABULARY.THINGS) is 
begin 


end REMOVE_OBJECT; 


procedure ADD_OBJECT (OBJECT : In VOCABULARY.THINGS) is 
egin 


end ADD_OBJECT; 
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A Ne 
procedure DISPLAY_CONTENTS is 
procedure PRINT (MSG : STRING) renames TEXT_IO.PUT_LINE; 


use VOCABULARY; - togaln visibility of WORDS 


begin 
for ITEM In VOCABULARY.THINGS 
loop 
 OBJECT_IS_PRESENT (OBJECT => ITEM) then 
case ITEM is 
when KEY => PRINT ("There Is a key here"); 
when NOTE => PRINT ("There Is a note here 5 
when LAMP => PRINT ("There Is a lamp here’ +H 
when GOLD => PRINT (“There Is gold here’ 5 
when SILVER => PRINT ("There is sliver here"); = 
when Ada => PRINT ("The lovely Ada is here") 
end case; 
end If; 
end loop; = for INDEX 


It THE_LOCATION = DUNGEON and 
(not DUNGEON_DOOR.IS_OPEN) then 


PRINT ("A closed door blocks the east exit}; 
end if; 
end DISPLAY_CONTENTS; 
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~ These three routines are used during the Initlallzation 
~ of the data structure, 


function PAD (S : STRING) return STRING Is 


+> This function converts a smaller string to one which 
-- Is constrained to 1 .. 60 (required length of messages), 


RESULT : STRING (1 .. 60) := (1... 60 =>"); 


begin 
RESULT (1 .. S'LAST) := 5S; 
return RESULT; 

end PAD; 


function INIT (OBJ : VOCABULARY.THINGS) return THING 
COLLECTION : THING SET := EMPTY. SET; rete 


COLLECTION (OBJ) := TRUE; 
return COLLECTION; 
end INIT; 


function INIT (OBJ1,0BJ2 : VOCABULARY.THINGS' 
COLLECTION : THING_SET := EMPTY SET; Peete WNISEY 


COLLECTION (OBW1) := TRUE; 
COLLECTION (OBJ2) := TRUE; 
return COLLECTION; 

end INIT; 


begin 
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use VOCABULARY; -- Direct visibility of WORDS 
begin 


-- This is the optional sequence of Sor ial which 
-- is executed when the package bod yi 
-- elaborated. It is used to set up THE_MAP. 


THE_MAP (ENTRANCE) := 


(PAD (You are at the entrance of a cave"), 
INIT (NOTE,LAMP), 
(BLOCKED, BLOCKED, BLOCKED, CAVE) ); 


THE_MAP (CAVE) := 
ep Wey eer are in alarge cave"), 


(ENTRANCE, GIANT_ROOM, 
BLOCKED, GOLD_ROOM) ); 


THE_MAP (GOLD_ROOM) := 


(PAD eee have entered the gold room’), 
(NITE 


D), 
(BLOCKED BLOCKED, CAVE, BLOCKED) ); 
THE_MAP (GIANT_ROOM) := 
) 


PAD 
EMPTY_ser, ) 
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GET 


TRANSFORM_1 


a 


POSITION_OF_ BLANK 


a 


TRANSFORM_2 


[| 


STRING_TO_WORDS 
Read an input string. 
If there is no blank, 
attempt to generate a one word command 
else attempt to generate a two-word command. 
If an error occurs, 
generate an appropriate message and 
repeat the entire process. 
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THE_MAP (CHAMBER) := 


THE_MAP (MAZE_1) := 


THE_MAP (MAZE_2) := 


THE_MAP (MAZE_3) := 


THE_MAP (MAZE_4) := 


THE_MAP (DUNGEON) := 


THE_MAP (CELL) := 


DISPLAY_MSG; 
DISPLAY_CONTENTS; 


end MAP; 


~ initial information 
-- for the player 
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with TEXT_10; 
separate (COMMAND. _INFO) 
procedure GET (CMD ;: out COMMAND) Is 


STR : STRING (1..30); - actual user Input 
COUNT : NATURAL; — actual # of characters in STR 
SPOT : NATURAL; 


— position of blank (if any) 
BAD_COMMAND : exception; 


function POSITION_OF_BLANK (WITHIN : STRING) 
retum NATURAL Is separate; 


function STRING _TO_WORDS (S : STRING) 
return VOCABULARY.WORDS Is separate; 


functlon TRANSFORM_1 (S : STRING) 
return COMMAND Ie separate; 


functlon TRANSFORM_2 (V, N : STRING) 
return COMMAND Is separate; 
begin 
TEXT_IO.GET_LINE (STR, COUNT); 
SPOT := POSITION_OF_BLANK (STR (1..COUNT)); 


i SPOT = 0 then 
CMD := TRANSFORM_1 (STR (1..COUNT)); 


CMD := TRANSFORM 2 (STR (1..SPOT-1), 
STR (SPOT + 1..COUNT)); 


end If; 
exception 


when BAD_COMMAND => GET(CMD); 
end GET; 


~ recursive 
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- VALID 

— VALID 

—- VALID 

— ILLEGAL 
— INVALID 


— ILLEGAL 


45678 9 


~ ILLEGAL 


— ILLEGAL 


~1ison 


1 4 9 10 11 
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separate (COMMAND_INFO.GET) 
function TRANSFORM_1 (S : STRING) return COMMAND is 


use VOCABULARY; 
THE_WORD : WORDS; 


begin 


THE_WORD := STRING_TO_WORDS (S); 
-- if no excaption, THE_WORD is legal 


case THE_WORD is 


-- holds converted noun or verb 


when QUIT | INVENTORY => 
tetum (THE_WORD, NORTH) -- NORTH is arbitrary 


when NORTH .. SOUTH => 
return (GO,THE_WORD); 


when others => 
raise BAD_COMMAND; 


end case; 
exception 
when BAD_COMMAND => 
TEXT_IO.PUT_LINE ("I don’t understand that command"); 
raise; 


end TRANSFORM_1; 


0 
AdaVENTURE ad 
eee Ne ee 


te (COMMAND_INFO.GET) 
function BOSITION OF_BLANK (WITHIN : STRING) 
return NATURAL is 


-- This function returns the ordinal position 
— of the first blank in the string and, if 
- no blank is found, returns zero. 


begin 
for INDEX in WITHIN'RANGE 
loop 
if WITHIN (INDEX) =" ‘then 
retum INDEX; 
end if; 
end loop; 
return 0; 
end POSITION_OF_BLANK; 
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separate (COMMAND_INFO. ee 
function TRANSFORM_2 (V, N : STRING) return COMMAND is 


~- This function simply returns an agreggate value. 
-- an exception will result if there is no match for 
-- either the VERB or the NOUN. 


begin 
return (STRING_TO_WORDS (V), 
STRING_TO_WORDS (N)); 
exception 


-- First, check for out-of-order conditions 
when CONSTRAINT_ERROR => 


TEXT_IO.PUT_LINE ("1 don't understand’); 
raise BAD_COMMAND; 


-- process ‘SAY' command while still a string 
when BAD_COMMAND => 


= "SAY" then 


if N = “abracADAbra” then 
retum (SAY, MAGIC_WORD); 


TEXT_IO.PUT(’‘OK.. ak 
TEXT_O. PUT: _LINE (N); 


else 


se 
Uae. [O.PUT_LINE(“I don't understand"); 


raise; 


end TRANSFORM_2; 
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separate (COMMAND_INFO.GET) 
function STRING_TO_WORDS (S : STRING) 
return VOCABULARY.WORDS Is. 
~ This function uses the ‘value’ attribute to convert from 
-- string to type WORDS. The attribute, by definition, raises 
— a constraint_error If no conversion Is possible. 
begin 
return VOCABULARY.WORDS'VALUE (S); 
exception 


when CONSTRAINT_ERROR => 
ralse BAD_COMMAND; 


end STRING _TO_WORDS; 
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ALLOWING SYNONYMS 


separate (COMMAND _INFO.GET) 
function STRING_TO_WORDS (S : STRING) return WORDS Ie 


type SYNONYM Is 
(NORTH, N, EAST, E, WEST, W, SOUTH, S, GOLD, 
SILVER, NOTE, LAMP, LANTERN, KEY, ADA, DOOR, 
GO, MOVE, TAKE, GRAB, GET, LIGHT, DROP, 
THROW, PUT, DISCARD, READ, SAY, OPEN, 
UNLOCK, QUIT, Q, INVENTORY, INVENT, INV); 


use VOCABULARY; 


TABLE : array (SYNONYM) of VOCABULARY.WORDS:= 


(NORTH, NORTH, EAST, EAST, WEST, WEST 
SOUTH, SOUTH, GOLD, SILVER, NOTE, LAMP, 
LAMP, KEY, ADA, DOOR, GO, GO, TAKE, TAKE, 
TAKE, LIGHT, DROP, DROP, DROP, DROP, READ, 
SAY, OPEN, UNLOCK, QUIT, QUIT, INVENTORY, 
INVENTORY, INVENTORY); 


begin 
return TABLE (SYNONYM'VALUE (S) ); 
exception 


when CONSTRAINT_ERROR => 
raise BAD_COMMAND; 


end STRING_TO_WORDS; 
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[eo 
co] 
SAY 


DROP 


UNLOCK 
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separate (COMMAND_INFO) 
function USER_QUITS (C : COMMAND) return BOOLEAN is 


use VOCABULARY; 


-- You might want to interact with the user to determine 
-- his/her actual wishes 


begin 
retum C.VERB = QUIT; 
end USER_QUITS; 


separate (COMMAND_INFO) 
function USER_WINS return BOOLEAN is 


begin 


-- an algorithm to assess winning criteria 
-- would go here 


end USER_WINS; 
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Exercises 1 


1. Scalar Types 


a. Declare an Integer type to represent lines on a CRT. 


Tye CRU Rs Ie range | 24 | 


b. Declare an object of the above type initialized to 24 lines. 


Myline seRTUnn 12243 


c. Declare a floating-point type with 9 digits of precision. 
Tye lM s-ELOAT ig digits @ J 


d. Declare a fixed-point type which will represent voltages between 
10.0 and 2000.0 volts with a granularity of 1/4 volt. — 


Tyee Volts te deltaQ Br rans 10,0 -, 2000.8 2 


e. Declare an enumeration type whose literals are the two-letter 
postal codes of the Confederate States of America. 


pi lang 


Ty un YB Z LOO is FAL, FL, GP, LA, Vk, ee 
‘a SC, vc, Rastng 7 


f. Declare a subtype of the above a eet eniy hose 
Confederate states which are completely land-locked. 


Oy TX 


t. , 
Subton Led loc is CON-CODE 4BR .. 1H 


g. Declare a character type (enumeration) for ranks of playing 
cards. Disregard the ak 6 Ze | 


th 


Type Cade 7 Psy 1429/84 /()0, © KR) 
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2. Composite Types 


a. Declare an array type for casualties incurred by each state of 
the Confederate States of America. 


b. Declare an object of the type with all values initially 0. 


c. Write an assignment statement indicating that Georgia had 13,597 
casualties. 


d. Declare a string constant which contains your name in the form: 
<first name><space><initial><.><space><last name> 


e. Declare a string variable (not a constant) which contains as an initial 
value your name in the form: 
<last name><,><space><first name><space><initial><.> 


The catch: With the exception of <,> you may use only catenation (&) and 
slices from the string constant declared in d. above. 


f. Declare a record type for complex numbers. 


Exercises 


INPUT/OUTPUT PRIMER 


1. Any program unit (procedure, package etc.) which does input/output 
operations should have the following context specification: 


with TEXT_IO; 
procedure <identifier> is 


This allows the application programmer the capability of inputting and outputting 
values of the predefined types STRING and CHARACTER. 


2. To input and output the predefined type INTEGER, the following declaration 
must appear within the declarative part of the procedure or package which will 
perform the operation: 

package INT_IO is new TEXT_IO.INTEGER_IO (INTEGER); 
3. To input and output values of the enumerated data type 

type DAYS is (SUN, MON, TUE, WED, THU, FRI, SAT); 


the following declaration must appear within the declarative part of the procedure 
or package which will perform the operation: 


package DAYS IO is new TEXT_IO.ENUMERATION_IO (DAYS); 


5. Given the above, the following are all valid statements: 


TEXT_IO.PUT ("This is a string literal"); 

TEXT_IO.PUT_LINE ("Only strings can use ""PUT_LINE™ "); 
INT_IO.PUT(17); 

INT_!0.PUT(17,5); -- right justified in a field of length 5 
DAYS_1O.PUT(WED); 

TEXT_IO.NEW_LINE; -- generates CR,LF for any data type 


Exereises 4 
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1. Given the following declarations: 
type DAYS is (SUN, MON, TUE, WED, THU, FRI, SAT); 
type LIST is array (DAYS) of NATURAL; 
MY_LIST : LIST := (2,4,6,8,10,12,14); 

write and execute an Ada procedure which will 


a. Output the value of the following attributes for type DAYS: 


FIRST LAST PRED (MON) 
SUCC (MON) VAL (2) VALUE ("WED") 
POS (FRI) IMAGE (SAT) 


NOTE: The first six are of type DAYS, the seventh of type universal integer and 
the last is of type STRING 


b. Output the value of the following attributes for type LIST: 


FIRST LAST LENGTH 


c. Output the values of MY_LIST 


Exercises 5 


2. Write a program which will print out all 3-digit numbers xyz (000-999) 
which have the property that xyz = x**n + y**n + z**n. The user of 

the program should be able to enter a value for n, receive a report and 
continue entering other values for n. The program should accept values 
of n as large as 10. the program should terminate when the user enters 
a value of zero. 


3. Write a boolean function which accepts a string and determines if 
the string is a palindrome (reads the same forwards and backwards). 
The strings should be one word long and palindromes, in our case, 
are case sensitive. That is, "ADA" and "radar" are palindromes while 
"Ada" and "PHONORTON" are not. Compile the function and then 
write a driver program which calls the function. 


4. Given the following types: 


type COLOR is (RED, BLUE, GREEN, MAGENTA, PURPLE); 
type LIGHT is (RED, GREEN, AMBER); 


write a program which contains a function which will convert from type 
COLOR to type LIGHT. That is, if the argument (of type COLOR) to the 
function represents an enumeration value whose value also appears in 
type LIGHT, then the conversion will be made successfully. If there is no 
corresponding value, a constraint error should be raised. 


5. Write a program which will ring the bell 5 times. 
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CALENDAR 


1. Write the package body to implement the following specification of the 
package CALENDAR_INFO. Add any utility routines to the body which you 
think might be helpful. The output should be in the form shown below. 


2. Write a driver program which has only the following two statements: 


PRINT_MONTH (1988, FEB, MON); 
PRINT_MONTH (1987,DEC, TUE); 


3. Modify the program to allow user selection of month, day and year. 


ANAAAAAAAAAAAAAAAAARARAARAAAAAAAAAARARRARA ATA RRRRRRAS 


package CALENDAR _INFO is 


type DAYS is (SUN, MON, TUE, WED, THU, FRI, SAT); 


type MONTHS is ( JAN, FEB, MAR, APR, MAY, JUN, 
JUL, AUG, SEP, OCT, NOV, DEC); 


subtype YEARS is NATURAL range 1901 .. 2099; 
procedure PRINT_MONTH ( YEAR __ : in YEARS; 


MONTH : in MONTHS; 
START : in DAYS); 


end CALENDAR_INFO; 
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[ g ROMAN NUMERAL 


r 
i} | 1. Write the body to implement the following package specification. The 
~ ROMAN NUMERALS are to follow the ancient form (9 = VIIII not IX). 


2. Write a driver program which will exercise all of the operations in 
the package. 


package ROMAN is 
type DIGIT is (I, 'V', 'X’, 'L’, 'C', 'D', 'M’); 
type DIGIT_STRING is array (POSITIVE range <>) of DIGIT; 


-- By definition DIGIT_STRINGs contain only DIGITS. 
<- "II", "IVI", XVXIX" ( but not "XVIAV") are legal DIGIT_STRINGS. 


type NUMERAL is private; 


type VALID_NUMBER is range 1 .. 4999; 
ILLEGAL_ROMAN_NUMERAL : exception; 


-- raised when illegal characters, converted number greater 
-- than 4999, empty input, invalid ordering of DIGITs or too many 
-- of a given DIGIT. 


procedure GET_VALID (RN : out NUMERAL); 


-- Interacts with user in order to input a valid roman numeral. 
-- ILLEGAL_ROMAN_NUMERAL can be raised. 


procedure PUT (RN : in NUMERAL); 


-- Outputs a ROMAN NUMERAL. No carriage return. 


function CREATE (S : DIGIT_STRING) return NUMERAL; 


-- ILLEGAL_ROMAN_NUMERAL will be raised if DIGITs are out 
-- of order or if there are too many of a given DIGIT. 
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ROMAN NUMERAL 


function "+" ( LEFT, RIGHT : NUMERAL) return NUMERAL; 
-- ILLEGAL_ROMAN_NUMERAL will be raised if sum exceeds 4999. 


function "<" (LEFT, RIGHT : NUMERAL) return BOOLEAN; 


function CONVERT (RN : NUMERAL) return VALID_NUMBER; 


-- RN of "VII" returns 7 
-- RN of "MMMMDCCCCLXXXXVIIII" returns 4999 


function CONVERT (VN : VALID _NUMBER) return NUMERAL; 


-- VN of 7 returns "VII" 
-- VN of 4999 returns "MMMMDCCCCLXXXXVIIII" 


private 
type NUMERAL is 
record 
SIZE: NATURAL; - ya actual DIGITs 
LIST : DIGIT STRING (1 .. 20); 
end record: 
end ROMAN; 


for a VALID_NUMBER of 7, LIST (1 .. 3) = "VII" and SIZE = 3. 
for a VALID_NUMBER of 2016, LIST (1 .. 5) = "MMXVI" and SIZE = 5. 
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Exercises 


CHANGE MAKER 


1. Given the following generic package specification for CHANGE_INFO, write 
the package body. 


2. Write a program which will use the generic package to provide change-making 
capability for United States currency using the following type: 


type DENOM is ( PENNY, NICKEL, DIME, QUARTER, HALF, 


ONE, FIVE, TEN, TWENTY, FIFTY ); 
3. Modify the program so that it will provide change-making capability for 
currency for some other country. If you do not know the currency of another 
country, make up something. 
NOTES: 
The user should be allowed to enter as many pairs of values as he/she wishes 
Values should not exceed 1000.00. 


Values should be entered with exactly 2 decimal places. (You may assume that 
the input has the correct number of decimal places. You need not validate this.) 


If the amount offered is less than the amount charged, the user should be 
informed and allowed to enter another pair of amounts. 
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CHANGE MAKER 


type CURRENCY_NAMES is (<>); 
type CURRENCY_LIST is array (CURRENCY_NAMES) of NATURAL; 
CURRENCY VALUES : in CURRENCY_LIST; 


generic 


-- CURRENCY_NAMES must be ordered ‘low-to-high' 
-- CURRENCY_VALUES represent canonical values for 
-- each denomination (TWENTY = 2000, etc.) 

package CHANGE_INFO is 


subtype CANONICAL_UNITS is NATURAL range 0 .. 100_000; 
type MONEY_TYPE is digits 5 range 0.0 .. 1_000.0; 


procedure GET_INPUT ( PRICE: out MONEY_TYPE; 
PAID : out MONEY_TYPE ); 


-- Interactively gets input from the user. The user will be allowed 


-- to reenter a data value in case of error. PAID must not be less than PRICE. 


function CHANGE_DUE (PRICE: MONEY_TYPE; 
PAID : MONEY_TYPE ) 
return CANONICAL UNITS; 


function MAKE_CHANGE (UNITS : CANONICAL_UNITS) 
return CURRENCY_LIST; 


-- Takes a value of CANONICAL_UNITS (perhaps pfennigs) and 
-- creates an array value which contains the appropriate number 
-- of each denomination to be issued in change. 


procedure PRINT_CURRENCY (MONEY : in CURRENCY _LIST); 
function USER_WANTS_TO_STOP return BOOLEAN; 


-- Interacts with the user to determine if any more pairs of values 
-- will be forthcoming. 


end CHANGE_INFO; 


aT id 
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procedure PLAY_AdaVENTURE 
package COMMAND_INFO 
package body COMMAND_INFO 
package VOCABULARY 
procedure GET 

procedure EXECUTE 

function USER_QUITS 

function USER_WINS 
procedure GO_RTN 

package PLAYER 


. package body PLAYER 


package DUNGEON_DOOR 
package body DUNGEON_DOOR 


. package MAP 


package body MAP 

procedure LIST_INVENTORY 
function POSITION_OF_BLANK 
function STRING_TO_WORDS 
function TRANSFORM_1 


. function TRANSFORM_2 
. package TEXT_IO 


CAT 
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Exercise 1 


A simple random number generator yielding a random number (RN) between 0.0 and 
1.0 is: 


SEED (SEED * 824) MOD 10657 

RN # SEED/ 10657 (This is ‘real’ division) 

1. Using the above algorithm, Implement a random number capability which will go 
into your library and be availble for use. The random number generator is to get the 
initial SEED value from the user of the function. The initial seed must be a five-digit 
odd integer. 


2. Test the random number generator by writing a program to generate 50 floating 
point numbers between 0.0 and 1.0; 


3. Test the random number generator by writing a program which will generate 1000 
integers between 0 and 9 and will print out a report of their frequencies. 


4. Write a program to generate random values from the following type: 
type Days is (SUN, MON, TUE, WED, THU, FRI, SAT); 
Test the program as in 3 above. 


5. Write a generic random capability which will work for any discrete type. 


Exercise 2 ii ! 
i 


Using object-oriented design, design, implement and test a generic queue package. 
The element type and the maximum number of elements should be passed as generic 


formal parameters. } 
1. OBJECT: Queue , 
2. CONSTRUCTORS EXCEPTIONS (if an | 


3. SELECTORS EXCEPTIONS (If an 


4. REQUIRED FROM CLIENT: 


a. Element type 
b. Maximum size of queue 


5. OUTSIDE VIEW (Package spec) 


Exercise 3 


1. Write a program containing four tasks. PRODUCER_1 sends strings to 
CONSUMER_1 and PRODUCER_2 sends strings to CONSUMER_2. The two 
consumer tasks will contain the entry declarations and the producer tasks 
will contain the calls. 


a. The two producer tasks should send their strings at an interval 
between one and two seconds (determined by a random number). 
Each producer task should send five messages. Each message 
should contain (at least) the name of the producer task. 


b. The two consumer tasks should print each message as soon as it 
is received. The consumer task should append the name of the 
consumer task to the message prior to printing. Sample output 
might look like this: 


MSG 5 FROM PRODUCER 1///CONSUMER 1 


2. Modify the above system so that the producer tasks contain the entry 
declarations and the consumer tasks contain the calls 


3. Modify the above system to insert a buffer task between the consumers 
and producers. Thus, the two producers will send messages to the buffer 
task, not knowing which consumer will pick them up. The two consumer 
tasks will pick up messages from the buffer task without knowing which 
producer sent them. The buffer task should buffer up at most 4 messages. 
In this case, the buffer tasks will contain the entry declarations and the 
producer and consumer tasks will contain the calls. 
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Solutions 1 


—— 


1. Scalar Typos 


a. Declare an Integer type to represent lines on a CAT. 


type CRT_LINES Is range 0 .. 66; 


b. Declare an object of the above type initialized to 24 lines. 
VT_100_MAX : CRT_LINES := 24; 


c. Declare a floating-point type with 9 digits of precision. 
type MY_FLOAT is digits 9; 


d. Declare a fixed-point type which will represent voltages between 
10.0 and 2000.0 volts with a granularity of 1/4 volt. 


type VOLTS is delta 0.25 range 10.0 .. 2000.0; 


@. Oeclare an enumeration type whose literals are the two-letter 
postal codes of the Conlederate States of America. 


type CSA is (LA, AL, NC, SC, TN, AR, VA, TX, FL, MS, GA); 


f. Declare a subtype of the above type contalning only those 
Confederate states which are completely land-locked. 


subtype LAND_LOCKED Is CSA range TN .. AR; 


g- Declare a character type (enumeration) for ranks of playing 
cards. Olsregard the joker. 


type RANKS Ie ('2', ‘3', ‘4’, ‘S', ‘6’, '7", ‘8’, '0', ‘T’, * 


O', ‘K’, 'A'); 
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THREE-DIGIT NUMBER PROBLEM (EXERCISE PG 5) 


with TEXT_1O; 
procedure THREE_DIGIT Is 


THE_NUMBER ~—: NATURAL range 0 .. 899; 


N : NATURAL range 0... 10; ~~ The power 
package INT_IO Is new TEXT_{O.INTEGER_IO (NATURAL); 
begin 
loop 
begin 
TEXT_IO.PUT_LINE (Enter Power (0 to quit)=); 
INT_IO.GET(N); 
exit when N = 0; 
TEXT_IO.PUT ("For N =); 
INT_1O.PUT (N.2); 
TEXT_IO.PUT_LINE ( the values are"); 
for X In 0... 9 loop 
for Y ind... 9 loop 
for ZIn0.. 9loop 
THE_NUMBER ‘= x°100 + Y°10 + Z; 
lt THE_NUMBER = X“*N+ YN + Z**N then 
INT_IO.PUT (THE_NUMBER); 
TEXT_IO.NEW_LINE; 
end if; 
endloop; --forZ 
end kop; --forY 
and boop; -- for X 
exception 
when TEXT_IO.DATA_ERROR | CONSTRAINT_ERROR => 
TEXT_IO.PUT_LINE (invalld power. Restart process."); 
and; — block 
end loop; 


end THREE_DIGIT; 


Solutions 2 


2. Composite Types 


a. Declare an array type for casualties Incurred by each state of 
the Confederate States of America. 


type CASUALTIES Is array (CSA) of natural; 


b. Declare an object of the type with all values Initlally 0. 
FATAL : CASUALTIES :=s (CASUALTIES'RANGE => 0); 


c, Write an assignment staternent indicating that Georgia had 13,597 
casualties, 
FATAL (GA) := 13_597; 


d. Declare a string constant which contains your name in the form: 
<first name><space><initial><.><space><last name> 


MY_NAME : constant STRING = “Richard E. Bolz"; 


@. Declare a string varlable (not a constant) which contalns as an Initial 
value your name in the form: 
<last name><,><space><{irst name><space><initial><.> 


THE_NAME : STRING(1..16) :=: MY_NAME (12 .. 15) & °) & 
MY_NAME (8 .. 8) & MY_NAME (1... 10); 


The catch: With the exception of <,> you may use only catenation (&) and 
slices from the string constant declared In d, above. 


{. Declare a record type for complex numbers. 


type COMPLEX is 
record 


REAL_PART: FLOAT := 0.0; 
IMAG_PART : FLOAT := 0.0; 


end record; 
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PALINDROME PROBLEM (EXERCISE PG 5) 


function IS_PALINDROME (STR : STRING) return BOOLEAN Is 


MIRROR_IMAGE : STRING (STR'FIRST .. STR'LAST); 


begin 
for INDEX In 1... STR'LAST 
loop 
MIRROR_IMAGE (INDEX) := STA ( (STR'LAST - INDEX) + 1); 
end loop; 


return STR = MIRROR_IMAGE; 
end IS_PALINDROME; 


ROCCO SCC CCC OCC ton et cocoo ten tecoteerceeccrcorcnny 
with TEXT_IO, IS_PALINDROME; 
procedure PALINDROME_CHECK Is 


S : STRING (1... 30); 
COUNT : NATURAL; 


begin 
loop 


TEXT_IO.PUT_LINE ("Enter a word (<CR> to quk)*); 
TEXT_IO.GET_LINE (S, COUNT); 
exh when COUNT = 0; 


TEXT_IO.PUT (S (1 .. COUNT); 


it IS_PALINDROME (S (1... COUNT) then 
TEXT_IO.PUT_LINE ("Is a palindrome); 
else 
TEXT_IO.PUT_LINE ("Is not a palindrome"); 
end it; 


end loop; 
end PALINDROME_CHECK; 
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CONVERSION PROBLEM (EXERCISE PG 5) 


with TEXT_IO; 
procedure CONVERSION is 


type COLOR Is (RED, BLUE, GREEN, MAGENTA, PURPLE); 
type LIGHT is (RED, GREEN, AMBER); 


function CONVERT (C : COLOR) retum LIGHT is 
begin 
return LIGHT VALUE (COLOR'IMAGE (C)); 
end CONVERT; 
begin 
for HUE In COLOR 
loop 


- COLOR'FIRST .. COLORLAST 


begin ~- block statement encapsulates exception handler 
TEXT_IO.PUT (LIGHTIMAGE (CONVERT (HUE))); 
TEXT_JO.PUT_LINE (Is in both types.”); 
exception 
when CONSTRAINT_ERROR => 
TEXT_IO.PUT (COLOR'IMAGE (HUE)); 
TEXT_IO.PUT_LINE (is In type COLOR only.); 
end; 
end loop; 


end CONVERSION; 
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TEXT PROBLEM 2 (STUDENT NOTES PG 190) 


with BOUNDED_LENGTH_STRING, TEXT_IO; 
use BOUNDED_LENGTH_STRING; 
procedure ONE_PER_LINE Is 


GET (THE_TEXT); 
# LENGTH (THE_TEXT) /= 0 then 
loop 
RIGHT «= POS ( *, THE_TEXT, START => LEFT); 
exit when RIGHT = 0; 
PUT_LINE (COPY (SOURCE => THE_TEXT, 
START => LEFT, 


COUNT => SIZE (RIGHT - LEFT))); 
LEFT v= RIGHT + 1; ’ FM) 


end loop; 
~ Output the final word 


PUT_LINE (COPY ( SOURCE => THE_TEXT, 
START =>LEFT, 
COUNT => LENGTH (THE_TEXT) - 
SIZE (LEFT) + 1)); 
end i; 
exception 
whon others => 


TEXT_IO.PUT_LINE (‘Unknown error"); 
end ONE_PER_LINE; 
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TEXT PROBLEM 1 (STUDENT NOTES PG 189) 


with BOUNDED_LENGTH_STRING, TEXT_IO; 
use BOUNDED_LENGTH_STRING; 
procedure SUBSTITUTE Is 


THE_TEXT : TEXT; 
SPOT : INDEX; 


begin 
GET (THE_TEXT); 
SPOT :» POS (PATTERN => "FRAMUS", SOURCE => THE_TEXT); 
# SPOT /= 0 then 


DELETE ( ORIGINAL => THE_TEXT, 
START »=>SPOT, 
COUNT =>8); 


INSERT ( SOURCE => "PHONORTON’, 
ORIGINAL => THE_TEXT, 
START => SPOT); 
end K; 


PUT (THE_TEXT); 
exception 
when SIZE_ERROR => 
TEXT_IO.PUT_LINE (TEXT too large"); 
end SUBSTITUTE; 


} 
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CALENDAR PROBLEM (EXERCISE PG 6) 


Package body CALENDAR_INFO Is 


subtype DAY_RANGE Is NATURAL range 1 .. 31; 
functlon LAST_DAY (Y : YEARS; M : MONTHS) retum DAY_RANGE ls 
begin 
case Mis 
when SEP | APR | JUN | NOV => return 30; 


when FEB => 


If Y¥ mod 4 = Othen 
teturn 29; 

else 
retum 28; 

end H; 


when others => return 31; 
end case; 
end LAST_DAY; 


procedure PRINT_MONTH (YEAR —:In YEARS; 
MONTH : in MONTHS; 
START :In DAYS) ls separate; 


end CALENDAR_INFO; 
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ROMAN NUMERAL PROBLEM (EXERCISE PG 7) 


with TEXT_IO; 
package body ROMAN is 


type CONVERT_ARRAY is array (DIGIT) of NATURAL; 


DIGIT_TO_NATURAL : constant CONVERT_ARRAY 
== (1,5, 10, 50, 100, 500, 1000); 


procedure GET_VALID (RN : out NUMERAL) is separate; 
procedure PUT (RN : in NUMERAL) is separate; 
function CREATE (S : DIGIT_STRING) return NUMERAL is separate; 


function CONVERT (VN : VALID_NUMBER) retum NUMERAL 
is separate; 


-- The preceding subprograms were represented as body stubs. 
-- Their associated subunits will be found on subsequent pages. 
-- The remaining subprograms must be represented as proper 
-- bodies because of the following rules: 


-- 1, The designators of all compilation units must be 
-- identifiers (operator symbols are not allowed). 


-- 2. The simple names of all subunits that have the same 
-» ancestor library unit must be distinct identifiers. 


DIGIT_TO_NATURAL 


Et 
v [ss 
x [707] 
v [a 
[07 
D [300 
a 


o 


Solutions 


CALENDAR PROBLEM (EXERCISE PG 6) 
with TEXT_}O; 


separate (CALENDAR_INFO) 
procedure PRINT_MONTH (YEAR : In YEARS; MONTH : In MONTHS; START :in DAYS) is 


TODAY : DAYS := START; 
THE_COL : artay (DAYS) of TEXT_IO.COUNT : (1, 7, 13, 19, 25, 31, 37); 


INT_{O is new TEXT_IO.INTEGER_IO (NATURAL); 
package MONTH_IO is new TEXT_IO.ENUMERATION_ IO (MONTHS); 


begin 
TEXT_IO.NEW_LINE; 


MONTH_IO.PUT(MONTH); 
TEXT_IO.SET_COL (35); 
INT_IO.PUT (YEAR.4); 
TEXT_IO.NEW_LINE; 


TEXTIO.PUTLINECS M T W T F Sy; 
TEXT_IO.NEW_LINE; 


for THE_DAY In 1 ., LAST_DAY (YEAR, MONTH) 
loop 


TEXT_IO.SET_COL (THE_COL (TODAY)); 
INT_IO.PUT (THE_DAY, 2); 


if TODAY = DAYS'LAST then 
TEXT_IO.NEW_LINE; 
TODAY <= DAYS'FIRST 
else 
TODAY := DAYS'SUCC (TODAY); 
ond Hf; 
‘end loop; 
TEXT_IO.NEW_LINE; 


end PRINT_MONTH; 
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ROMAN NUMERAL PROBLEM (EXERCISE PG 7) 


ai "+" (LEFT, RIGHT : NUMERAL) return NUMERAL is 
agin 
retum CONVERT (CONVERT (LEFT) + CONVERT (RIGHT ) ); 
exception 
when CONSTRAINT_ERROR => 
pail raise ILLEGAL_ROMAN_NUMERAL; 
+; 


pea “<” (LEFT, RIGHT : NUMERAL) return BOOLEAN is 
egin 

4 retum CONVERT (LEFT) < CONVERT ( RIGHT); 
end "<"; 


function CONVERT (RN : NUMERAL) return VALID_NUMBER is 


SUM : NATURAL ‘= 0; 
begin 
for INDEX in 1 .. RN.SIZE 
loop 
SUM ‘= SUM + DIGIT_TO_NATURAL (RN.LIST (INDEX); 
end loop; 
return VALID_NUMBER (SUM); 
end CONVERT; 
end ROMAN; 
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ROMAN NUMERAL PROBLEM (EXERCISE PG 7) 


separate (ROMAN) 
procedure GET_VALID (RN : out NUMERAL) is 


STR 2 STRING (1 .. 20); — The input string 
COUNT : NATURAL; — # of characters entered 
_ NUM : DIGIT_STRING (1 .. 20); — Result of conversion 


in 
TEXT_1!O.PUT_LINE (“Enter a roman numeral"); 
TEXT_IO.GET_LINE (STR, COUNT); 
for CH in 1 .. COUNT 


loo 
NUM(CH) t= DIGIT VALUE(CHARACTER'IMAGE (STR (CH))); 
end loop; 


RN = CREATE (NUM (1 .. COUNT)); — Pass DIGIT_STRING to the 
; — CREATE function. 
exception 
when ILLEGAL_ROMAN_NUMERAL => : 
raise; — Error message was already printed in CREATE 


when CONSTRAINT_ERROR => 
TEXT_IO.PUT_LINE ("Illegal characters in Roman Numeral’); 
raise [LLEGAL_ROMAN_NUMERAL; 


end GET_VALID; 
COUNT 
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ROMAN NUMERAL PROBLEM (EXERCISE PG 7) 


separate (ROMAN) 

function CREATE (S : DIGIT_STRING) return NUMERAL is 
RESULT : NUMERAL; 
LIMITS : constant CONVERT_ARRAY := (4, 1,4, 1,4, 1, 4); 
TOTAL : CONVERT_ARRAY := (TT ..'M' => 0); 

begin 
-- Treat the first DIGIT separately 
TOTAL (S(1)) := TOTAL (S(1)) + 1; 


-- Check for out-of-order errors, sum up number of DIGITs 
for INDEX in 2 .. SLENGTH 
loop 
TOTAL (S (INDEX)) = TOTAL (S (INDEX)) + 1; 
if S(INDEX) > S (INDEX - 1) then 
TEXT_{O.PUT_LINE ("Digits out-of-order’); 
raise ILLEGAL_ROMAN_NUMERAL; 
end if; 
end loop; 


-- Check for correct number of each DIGIT 
for INDEX in DIGIT 
loop 
if TOTAL (INDEX) > LIMITS (INDEX) then 
TEXT _1O.PUT_LINE (‘Too many of a given digit); 
raise ILLEGAL_ROMAN_NUMERAL; 


end if; 
end loop; 


-- S represents a valid NUMERAL 
RESULT.SIZE := SLENGTH; 
RESULT.LIST (1 .. RESULT.SIZE) := S; 
return RESULT; 


end CREATE; 
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ROMAN NUMERAL PROBLEM (EXERCISE PG 7) 


separate (ROMAN) 
procedure PUT (RN: in NUMERAL) is 


STR : STRING (1 .. RN.SIZE); 
begin 


for CHin 1 .. RN.SIZE 
loo, 

PSTR (CH) = CHARACTER'VALUE (DIGIT IMAGE (RN.LIST (CH))); 
end loop; 


TEXT_IO.PUT (STR); 
end; 


1 2 3 
Solutions 15 
LIMITS TOTAL 
a a ’ [oes 
v [1] vi {oo 
x [a x [oO] 
ey ae [oo] 

a ce [oO] 
vt >» [oT 
a wu [oT 


RESULT 


Ei 


123 4 6 6 7 8 9 10 11 12 .. 20 
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ROMAN NUMERAL PROBLEM (EXERCISE PG 7) 


separate (ROMAN) 

function CONVERT (VN : VALID_NUMBER) return NUMERAL Is 
RN: NUMERAL; 
NUM: NATURAL := NATURAL (VN); 


begin 
RN.SIZE ‘= 0; 
La INDEX in reverse DIGIT -- Try all DIGITs (beginning with ‘M’) 
loop 
-- spin through all occurences (if any) of this digit 
loop 
exit when DIGIT_TO_NATURAL (INDEX) > NUM; 
RN.SIZE := RN.SIZE + 1; 
RN.LIST (RN.SIZE) = INDEX; 
NUM ‘= NUM - DIGIT_TO_NATURAL (INDEX); 
end loop; 
end loop; DIGIT_TO_NATURAL 
retum RN; T 
end CONVERT: v [5s | 
VN x [10 | 
v [a7 
LC] c | 100 | 
NUM ‘o [7s00] 
[J wr [io 
RN 
[SIZE | 
| UIST | 
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CHANGE MAKER PROBLEM (EXERCISE PG 9) 


with CHANGE_INFO; 
procedure CHANGE_MAKER is 


-- Set up actual generic parameters 


type DENOM is ( PENNY, NICKEL, DIME, QUARTER, HALF, 
ONE, FIVE, TEN, TWENTY); 


type DENOM_LIST is array (DENOM) of NATURAL; 
MY_VALUES : constant DENOM_LIST := 
(1,5, 10, 25, 50, 100, 500, 1000, 2000); 
-- Create an instance of the generic package 
package U_S_CHANGE Is new CHANGE_INFO 
(CURRENCY_NAMES => DENOM, 
CURRENCY_LIST => DENOM _LIST, 
CURRENCY_VALUES => MY_VALUES); 
use U_S_ CHANGE; 
-- Declare loca! objects to be used 


AMOUNT_CHARGED :MONEY_TYPE; 
AMOUNT_PAID : MONEY_TYPE; 


begin 
loop 
GET_INPUT (AMOUNT_CHARGED, AMOUNT _PAID): 


PRINT_CURRENCY 
(MAKE_CHANGE 
(CHANGE _DUE (AMOUNT_CHARGED, AMOUNT_PAID))); 


exit when USER_WANTS_TO_STOP; 
end loop; 
end CHANGE_MAKER; 
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CHANGE MAKER PROBLEM (EXERCISE PG 9) 


with TEXT_IO; 
package body CHANGE_INFO Is 


package MONEY_IO Is new TEXT_IO.FLOAT_IO (MONEY_TYPE); 


package INT_IO is new TEXT_IO.INTEGER_IO (NATURAL); 


package DENOM_IO Is new TEXT_IO.ENUMERATION IO 
(CURRENCY_NAMES); 


procedure GET_INPUT ( PRICE: out MONEY_TYPE; 
PAID : out MONEY_TYPE) Is separate; 


— Initial ‘stub’: PRICE := 2.37; 
- PAID := 20.00; 


function CHANGE_DUE ( PRICE: MONEY _TYPE; 
PAID : MONEY_TYPE) 
return CANONICAL_UNITS Is separate; 


~ initial ‘stub’: retum 1763; 


functlon MAKE CHANGE ( UNITS : CANONICAL_UNITS) 
return CURRENCY_LIST Is separate; 


— Initial ‘stub’: retum (3, 0, 1, 0, 1, 2, 1, 1); 


procedure PRINT_CURRENCY (MONEY : In CURRENCY_LIST) 
Is separate; 


function USER_WANTS_TO_STOP return BOOLEAN 
Is separate; 


-- Initial ‘stub’: retum TRUE; 


end CHANGE_INFO; 
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CHANGE MAKER PROBLEM (EXERCISE PG 9) 


separate (CHANGE_INFO) 
procedure GET_INPUT ( PRICE : out MONEY_TYPE; 
PAID: out MONEY_TYPE) is 


PRICE_LENTERED __: MONEY_TYPE; 
PAYMENT_ENTERED : MONEY_TYPE; 


procedure INPUT (AMOUNT : out MONEY_TYPE) is separate; 


begin 
TEXT_lO.PUT_LINE (“All values should have two decimal places”); 


loop 


TEXT_IO.PUT (“PRICE: "); 
INPUT (PRICE_ENTERED); 
TEXT_IO.NEW_LINE; 


TEXT_IO.PUT (“PAID: ”); 
INPUT (PAYMENT_ENTERED); 
TEXT_IO.NEW_LINE; 


exit when PAYMENT_ENTERED >= PRICE_ENTERED; 
TEXT_IO.PUT_LINE (“Insufficient payment; try again.”); 

end loop; 

PRICE := PRICE_ENTERED; __ -- send appropriate values 

PAID := PAYMENT_ENTERED; -- back through the out parameters 


end GET_INPUT; 
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CHANGE MAKER PROBLEM (EXERCISE PG 9) 


separate (CHANGE_INFO.GET_INPUT) 
procedure INPUT (AMOUNT : out MONEY_TYPE) is 


begin 
loop 
begin 
MONEY_IO.GET(AMOUNT); 
exit 
exception 
when TEXT_IO.DATA_ERROR => 


TEXT_IO.SKIP_LINE; 
TEXT_IO.PUT_LINE (" ERROR : Input value again”); 


when CONSTRAINT_ERROR => 
TEXT_IO.PUT_LINE (" ERROR : Input value again”); 
end; 
end loop; 
end INPUT; 


ANANA ANNA AN SSRN NNR NN RRNA RNR NRE RNR RES EER N SENN SESE SSS TST 


separate (CHANGE_INFO) 

function CHANGE_DUE (PRICE : MONEY_TYPE; 
PAID _:MONEY_TYPE) 
return CANONICAL_UNITS is 


begin 
retum CANONICAL_UNITS (( PAID - PRICE ) * 100.0); 
end CHANGE_DUE; 
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CHANGE MAKER PROBLEM (EXERCISE PG 9) 


separate (CHANGE_INFO) 
procedure PRINT_CURRENCY (MONEY : in CURRENCY_LIST) is 


begin 
= INDEX in CURRENCY_LISTRANGE 
loop 
if MONEY (INDEX) > 0 then 
DENOM_1O.PUT (INDEX); 
TEXT_IO.SET_COL(12); 
TEXT_IO.PUT (“= 


ik "Yi 
INT_IO. PUT (MONEY (INDEX)); 
TEXT_IO.NEW_LINE; 


end if; 
end loop; 


end PRINT_CURRENCY; 
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CHANGE MAKER PROBLEM (EXERCISE PG 9) 


separate (CHANGE_INFO) 
function MAKE_CHANGE (UNITS : CANONICAL_UNITS) 
retum CURRENCY_LIST is 


RESULT : CURRENCY _LIST; 
COINS :CANONICAL_UNITS := UNITS; 


begin 
for INDEX in CURRENCY_LISTRANGE 
Joop 


RESULT (INDEX) = COINS / CURRENCY_VALUES (INDEX); 
COINS c= COINS MOD CURRENCY_VALUES (INDEX); 


end loop; 
return RESULT; 
end MAKE_CHANGE; 


CURRENCY_VALUES RESULT UNITS 
penny [1 | PENNY [| 
NICKEL ez NICKEL 

DIME | 10 | DIME COINS 
QUARTER | 25 | QUARTER C_] 
HALF | 50 | HALF 

ONE | 100 | ONE 

FIVE | 500 | FIVE 

TEN } 1000 | TEN 

TWENTY | 2000 | TWENTY 
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CHANGE MAKER PROBLEM (EXERCISE PG 9) 


separate (CHANGE_INFO) 
function USER_WANTS_TO_STOP return BOOLEAN is 


RESPONSE T STRING (1 .. 10); 
COUNT : NATURAL; 


begin 


TEXT_IO.PUT_LINE (“Do you want to enter another pair” & 
“of amounts (Y or N)"); 


TEXT_IO.GET_LINE (RESPONSE, COUNT); 
retum RESPONSE (1) =’N' or RESPONSE (1) ='‘n’; 


exception 


when others => 


TEXT_IO.PUT_LINE ("Illegal input ~ 'No* ); 
return TRUE; ep re ge 


end USER_WANTS_TO_STOP; 
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Procedure PLAY_AdaVENTURE 
Package COMMAND_INFO 
Package body COMMAND_INFO 
package VOCABULARY 
Procedure GET 

Procedure EXECUTE 

functlon USER_QUITS 

functlon USER_WINS 
Procedure GO_RTN 


. package PLAYER 

« package body PLAYER 

+ packaga DUNGEON_DOOR 

» package body DUNGEON_DOOR 
. package MAP 

+ package body MAP 

- procedure LIST_INVENTORY 


function POSITION_OF_BLANK 


. function STRING_TO_WORDS 
. functlon TRANSFORM_1 

. functlon TRANSFORM_2 

. package TEXT_IO 


XXX 
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